diff --git a/LeanPool.lean b/LeanPool.lean index a81ab7a85f..b547f77c11 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -8611,6 +8611,354 @@ public import LeanPool.SpherePacking.MellinAnalysis public import LeanPool.SpherePacking.PackingBound public import LeanPool.SpherePacking.RadialConstruction public import LeanPool.SpherePacking.SaddleAnalysis +public import LeanPool.Stafford38 +public import LeanPool.Stafford38.AlgebraicAnalysis +public import LeanPool.Stafford38.AlgebraicAnalysis.Commutator +public import LeanPool.Stafford38.AlgebraicAnalysis.CommutatorRiccati +public import LeanPool.Stafford38.AlgebraicAnalysis.Derivation.Central +public import LeanPool.Stafford38.AlgebraicAnalysis.Derivation.Escape +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.Basic +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.CoordinateGeneration +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.FormallyEtaleDerivations +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.LocalizedPolynomialCommutant +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.LocalizedPolynomialDerivations +public import LeanPool.Stafford38.AlgebraicAnalysis.FieldTheory.FunctionField +public import LeanPool.Stafford38.AlgebraicAnalysis.LinearAlgebra.FiniteTaylorReconstruction +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.BaseLocalizationModuleComparison +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.BaseLocalizedKoszulPositivity +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.CommutingPolynomialAction +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.DenominatorTorsion +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EndomorphismKernelSupport +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EndomorphismKernelSupportOverBase +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EscapeAssembly +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EscapeSpan +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredSchreyer +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredStrictness +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermBoundaryExhaustion +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermBoundaryNaturality +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPageActions +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPageEquivalences +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPages +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermSuccessorNaturality +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermTotalActions +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermTotalPages +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FreeSummandInduction +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.HyperplaneRestriction +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.LocalizedKernelCokernelEquivalences +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.LocalizedMinimalSupportAvoidance +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MinimalPrimeFiniteLengthLocalization +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MinimalSupportExistence +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MinimalSupportKernelCokernelLengths +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MonicAnnihilatorFinite +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulFiniteTorsion +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulMinimalSupportPositivity +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulPositivity +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulSupportOverBase +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.RankExact +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.RankTorsion +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.RightCoordinates +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.Splice +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.SplitLatticePresentation +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.StableTorsionResidualSupport +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.StablyFree +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.TorsionProjectiveImage +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.TriangularDenominator +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.TwoSimplicity +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.TwoTermPageLength +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.UniformBoundaryVanishing +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.Unimodular +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.ActiveCoordinate +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Associativity +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.IteratedPBW +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.IteratedTower +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.LeftPBW +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Localization +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.LocalizationExtension +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.PrincipalRightIdeal +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightDivision +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightHilbertBasis +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightIntersection +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightLocalization +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightPBW +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightQuotient +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Tower +public import LeanPool.Stafford38.AlgebraicAnalysis.Polynomial.DistinguishedVariable +public import LeanPool.Stafford38.AlgebraicAnalysis.RingTheory.TwoGeneratorIdentity +public import LeanPool.Stafford38.FixedSourceSolution +public import LeanPool.Stafford38.Proofs.Stafford38Reduction +public import LeanPool.Stafford38.Proofs.WeylPurePower +public import LeanPool.Stafford38.Proofs.WeylSymplectic +public import LeanPool.Stafford38.Solution +public import LeanPool.Stafford38.Stafford38 +public import LeanPool.Stafford38.Stafford38.CanonicalSupportVanishingReduction +public import LeanPool.Stafford38.Stafford38.Characteristic.ArtinianAdaptedBasisExistence +public import LeanPool.Stafford38.Stafford38.Characteristic.ArtinianAdaptedBasisTraceAdapter +public import LeanPool.Stafford38.Stafford38.Characteristic.ArtinianCoefficientField +public import LeanPool.Stafford38.Stafford38.Characteristic.ArtinianEquation33TraceProducer +public import LeanPool.Stafford38.Stafford38.Characteristic.ArtinianTriangularTrace +public import LeanPool.Stafford38.Stafford38.Characteristic.AssociatedGradedFinite +public import LeanPool.Stafford38.Stafford38.Characteristic.AssociatedGradedModule +public import LeanPool.Stafford38.Stafford38.Characteristic.BGab001CoefficientFieldTrace +public import LeanPool.Stafford38.Stafford38.Characteristic.BaseLocalizationModuleComparison +public import LeanPool.Stafford38.Stafford38.Characteristic.BaseLocalizedKoszulPositivity +public import LeanPool.Stafford38.Stafford38.Characteristic.BaseRelativePoisson +public import LeanPool.Stafford38.Stafford38.Characteristic.BaseZeroSection +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalAxisAvoidanceConsumer +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalAxisMonicInitialTop +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalBaseVariety +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalCertificate +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalFilteredGradedBridge +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalFilteredTwoTerm +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalGabberInvolutivityInterface +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalGradedTangentialEquivalences +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalKoszulContradiction +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalLaurentSymbolControl +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalMonicSaturation +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalNoncharacteristicCancellation +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalNormalAxisSupport +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalNormalSymbolFiniteness +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalOldTangentialFiniteness +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalPageEulerInequality +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalResidueExtensionSymbolControlAdapter +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalSupportAvoidanceFromCokernel +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTangentialBoundaryMaps +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTangentialPageOperators +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTangentialRingEquivalence +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTangentialSuccessors +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTangentialSymbolFiniteness +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTangentialTotalAction +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTotalGradedActionCompatibility +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTotalGradedBridge +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalUnitCoordinatePreimage +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalUnitPreimageFromInitialTop +public import LeanPool.Stafford38.Stafford38.Characteristic.CommutingPolynomialAction +public import LeanPool.Stafford38.Stafford38.Characteristic.ConcreteEquation33SourceMatrices +public import LeanPool.Stafford38.Stafford38.Characteristic.ConcreteInducedZAction +public import LeanPool.Stafford38.Stafford38.Characteristic.ConcreteLocalizedTwoBlockSpecialFibre +public import LeanPool.Stafford38.Stafford38.Characteristic.ConcreteSquareZeroTraceData +public import LeanPool.Stafford38.Stafford38.Characteristic.EmptySupportVanishing +public import LeanPool.Stafford38.Stafford38.Characteristic.EndomorphismKernelSupport +public import LeanPool.Stafford38.Stafford38.Characteristic.EndomorphismKernelSupportOverBase +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotient +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientGraded +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientRees +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientReesAction +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientReesExact +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientSpecialFibre +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientSupport +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientTwoJet +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermBoundaryExhaustion +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermBoundaryNaturality +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermPageActions +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermPageEquivalences +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermPages +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermSuccessorNaturality +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermTotalActions +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermTotalPages +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredVanishing +public import LeanPool.Stafford38.Stafford38.Characteristic.GabberGlobalAssembly +public import LeanPool.Stafford38.Stafford38.Characteristic.GeometricSupportDescent +public import LeanPool.Stafford38.Stafford38.Characteristic.GeometricSupportScalarExtension +public import LeanPool.Stafford38.Stafford38.Characteristic.HomogeneousChart +public import LeanPool.Stafford38.Stafford38.Characteristic.HyperplaneRestriction +public import LeanPool.Stafford38.Stafford38.Characteristic.InitialIdeal +public import LeanPool.Stafford38.Stafford38.Characteristic.InitialIdealHomogeneous +public import LeanPool.Stafford38.Stafford38.Characteristic.LinearAction +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedHighPowerTwoBlockVanishing +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedKernelCokernelEquivalences +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedMinimalSupportAvoidance +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedOrderReesTwoJetSpecializationKernel +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedSpecializationActionCompatibility +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedTwoBlockModuleExactness +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedTwoBlockPrincipalKernelDescent +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedTwoBlockQuotient +public import LeanPool.Stafford38.Stafford38.Characteristic.MinimalPrimeFiniteLengthLocalization +public import LeanPool.Stafford38.Stafford38.Characteristic.MinimalPrimePoisson +public import LeanPool.Stafford38.Stafford38.Characteristic.MinimalSupportExistence +public import LeanPool.Stafford38.Stafford38.Characteristic.MinimalSupportKernelCokernelLengths +public import LeanPool.Stafford38.Stafford38.Characteristic.MonicAnnihilatorFinite +public import LeanPool.Stafford38.Stafford38.Characteristic.NoncharacteristicMinimalPrime +public import LeanPool.Stafford38.Stafford38.Characteristic.NormalSymbolPolynomial +public import LeanPool.Stafford38.Stafford38.Characteristic.OrderReesTwoJet +public import LeanPool.Stafford38.Stafford38.Characteristic.OrderReesTwoJetBracket +public import LeanPool.Stafford38.Stafford38.Characteristic.OrderReesTwoJetSpecializationKernel +public import LeanPool.Stafford38.Stafford38.Characteristic.Polynomial +public import LeanPool.Stafford38.Stafford38.Characteristic.PostScalarExtensionPoisson +public import LeanPool.Stafford38.Stafford38.Characteristic.PrincipalKoszulFiniteTorsion +public import LeanPool.Stafford38.Stafford38.Characteristic.PrincipalKoszulMinimalSupportPositivity +public import LeanPool.Stafford38.Stafford38.Characteristic.PrincipalKoszulPositivity +public import LeanPool.Stafford38.Stafford38.Characteristic.PrincipalKoszulSupportOverBase +public import LeanPool.Stafford38.Stafford38.Characteristic.RadicalMinimalPrimeInvolutivity +public import LeanPool.Stafford38.Stafford38.Characteristic.ReducedSupportIdeal +public import LeanPool.Stafford38.Stafford38.Characteristic.RightReesArtinianAdapter +public import LeanPool.Stafford38.Stafford38.Characteristic.SourceActionCommutatorExpansion +public import LeanPool.Stafford38.Stafford38.Characteristic.SpecializedNoncharacteristicEquality +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroAnnihilatorBracket +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroArtinianTruncation +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroHighPowerReduction +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroLinearTrace +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroLocalizedExactness +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroLocalizedRing +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroOreLocalization +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroTraceData +public import LeanPool.Stafford38.Stafford38.Characteristic.StableTorsionResidualSupport +public import LeanPool.Stafford38.Stafford38.Characteristic.SymplecticCompletion +public import LeanPool.Stafford38.Stafford38.Characteristic.TransposedFilteredModuleSupport +public import LeanPool.Stafford38.Stafford38.Characteristic.TwoTermPageLength +public import LeanPool.Stafford38.Stafford38.Characteristic.UniformBoundaryVanishing +public import LeanPool.Stafford38.Stafford38.Characteristic.ZeroSectionContainment +public import LeanPool.Stafford38.Stafford38.CoordinateDifferentialGeneration +public import LeanPool.Stafford38.Stafford38.DifferentialOperators +public import LeanPool.Stafford38.Stafford38.EulerRootSeparation +public import LeanPool.Stafford38.Stafford38.EvolutionaryCertificate +public import LeanPool.Stafford38.Stafford38.EvolutionaryCorollary +public import LeanPool.Stafford38.Stafford38.FixedSourceAssembly +public import LeanPool.Stafford38.Stafford38.FixedSourceChallengeTransport +public import LeanPool.Stafford38.Stafford38.FixedSourceStatement +public import LeanPool.Stafford38.Stafford38.FoundationClosure +public import LeanPool.Stafford38.Stafford38.Geometry.AffineComponentCoordinateSplit +public import LeanPool.Stafford38.Stafford38.Geometry.AffineConormalClosure +public import LeanPool.Stafford38.Stafford38.Geometry.AffineConormalSpan +public import LeanPool.Stafford38.Stafford38.Geometry.ArcFrameConormal +public import LeanPool.Stafford38.Stafford38.Geometry.AsymptoticChartArcAdapter +public import LeanPool.Stafford38.Stafford38.Geometry.AsymptoticDivisorExistence +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalAsymptoticLaurentProducer +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalConstantCoordinateBranch +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalFiniteGradientProjectiveCoordinates +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalNonconstantFiniteGradientProduction +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalNonconstantFiniteGradientProductionProof +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalResidueExtensionAssembly +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalVisibleDivisorFrameProduction +public import LeanPool.Stafford38.Stafford38.Geometry.ChartArcAnnihilation +public import LeanPool.Stafford38.Stafford38.Geometry.CoisotropicTranslation +public import LeanPool.Stafford38.Stafford38.Geometry.CompletedDVRCoefficientSection +public import LeanPool.Stafford38.Stafford38.Geometry.CompletedDVRPowerSeriesEquiv +public import LeanPool.Stafford38.Stafford38.Geometry.ComponentFunctionFieldBoundary +public import LeanPool.Stafford38.Stafford38.Geometry.ComponentProjectiveClosure +public import LeanPool.Stafford38.Stafford38.Geometry.ComponentProjectiveClosureNormalization +public import LeanPool.Stafford38.Stafford38.Geometry.ComponentProjectiveOrder +public import LeanPool.Stafford38.Stafford38.Geometry.ConormalAxisContradiction +public import LeanPool.Stafford38.Stafford38.Geometry.ConormalPrincipalOpenDensity +public import LeanPool.Stafford38.Stafford38.Geometry.ConormalScalarExtensionVanishing +public import LeanPool.Stafford38.Stafford38.Geometry.ConstantCoordinateConormal +public import LeanPool.Stafford38.Stafford38.Geometry.ContinuousPowerSeriesTangentFrame +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorTangentLattice +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorialBoundaryExtension +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorialVisibleFrameCore +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorialVisibleFrameStage2 +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorialVisibleFrameStage4 +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorialVisibleFrameStage5 +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorialVisibleFrameStageAssembly +public import LeanPool.Stafford38.Stafford38.Geometry.ExactDivisorialVisibleFrameExistence +public import LeanPool.Stafford38.Stafford38.Geometry.ExactVisibleDivisorFrameInterface +public import LeanPool.Stafford38.Stafford38.Geometry.FibreConicalVanishingIdeal +public import LeanPool.Stafford38.Stafford38.Geometry.FiniteGradientBoundaryProducer +public import LeanPool.Stafford38.Stafford38.Geometry.FiniteGradientFromTangentInclusion +public import LeanPool.Stafford38.Stafford38.Geometry.FiniteGradientResidueExtension +public import LeanPool.Stafford38.Stafford38.Geometry.FiniteSeparableDVRChartFoundation +public import LeanPool.Stafford38.Stafford38.Geometry.FixedWitnessTangentSqueeze +public import LeanPool.Stafford38.Stafford38.Geometry.FormalDivisorAxisLift +public import LeanPool.Stafford38.Stafford38.Geometry.FormalDivisorLaurentConormal +public import LeanPool.Stafford38.Stafford38.Geometry.FormalDivisorTangent +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralAsymptoticConormal +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralAsymptoticLaurentAxis +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralCoisotropicCanonicalAdapter +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralCoisotropicExclusion +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralCoisotropicSets +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralCoisotropicSetsTest +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralComponentConormalContainment +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralConormalAxis +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralConormalContainment +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralConstantCoordinateAxis +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralCoordinateAvoidance +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralDivisorialVisibleFrame +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralTangentLatticePresentation +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralTangentLimitCriterion +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralTangentLimitCriterionTest +public import LeanPool.Stafford38.Stafford38.Geometry.GenericPointKaehlerConormal +public import LeanPool.Stafford38.Stafford38.Geometry.GenericSmoothOpen +public import LeanPool.Stafford38.Stafford38.Geometry.JacobianConormalComparison +public import LeanPool.Stafford38.Stafford38.Geometry.KaehlerDVRVisibility +public import LeanPool.Stafford38.Stafford38.Geometry.KaehlerSpanSeparableAdjoin +public import LeanPool.Stafford38.Stafford38.Geometry.KaehlerVisibleDerivationFrame +public import LeanPool.Stafford38.Stafford38.Geometry.LaurentConormalDirection +public import LeanPool.Stafford38.Stafford38.Geometry.LaurentConormalResidueExtension +public import LeanPool.Stafford38.Stafford38.Geometry.LocalizedProjectiveChartTransition +public import LeanPool.Stafford38.Stafford38.Geometry.NormalizationHeightOne +public import LeanPool.Stafford38.Stafford38.Geometry.OneVariableAmbientConormal +public import LeanPool.Stafford38.Stafford38.Geometry.OneVariablePrimeConormal +public import LeanPool.Stafford38.Stafford38.Geometry.PointwiseConormalContainment +public import LeanPool.Stafford38.Stafford38.Geometry.PowerSeriesArcTangency +public import LeanPool.Stafford38.Stafford38.Geometry.PowerSeriesTangentLimit +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveBoundaryFrameRank +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveConormalDehomogenization +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveConormalDirections +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveDivisorOrderGap +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveEquationFormalChart +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveTangentInclusion +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveValuationNormalization +public import LeanPool.Stafford38.Stafford38.Geometry.RelativeCoefficientDVRPlace +public import LeanPool.Stafford38.Stafford38.Geometry.RelativeDivisorialTower +public import LeanPool.Stafford38.Stafford38.Geometry.RelativeFractionFieldTransport +public import LeanPool.Stafford38.Stafford38.Geometry.RelativeRetainedBoundaryPlace +public import LeanPool.Stafford38.Stafford38.Geometry.ResidueMinorSelection +public import LeanPool.Stafford38.Stafford38.Geometry.RetainedComponentEquationPackage +public import LeanPool.Stafford38.Stafford38.Geometry.RetainedDVRPlace +public import LeanPool.Stafford38.Stafford38.Geometry.RetainedGroundMapIdentification +public import LeanPool.Stafford38.Stafford38.Geometry.RetainedPlaceConormalTransport +public import LeanPool.Stafford38.Stafford38.Geometry.RetainedProjectiveCompletion +public import LeanPool.Stafford38.Stafford38.Geometry.RetractionSpecialization +public import LeanPool.Stafford38.Stafford38.Geometry.ScalarExtensionPoints +public import LeanPool.Stafford38.Stafford38.Geometry.SeparableResidueDerivationExtension +public import LeanPool.Stafford38.Stafford38.Geometry.SmoothAffineConormal +public import LeanPool.Stafford38.Stafford38.Geometry.SmoothConormalFibreVanishing +public import LeanPool.Stafford38.Stafford38.Geometry.SplitTangentMatrix +public import LeanPool.Stafford38.Stafford38.LeftDenominatorTransport +public import LeanPool.Stafford38.Stafford38.LeftHandedCorollary +public import LeanPool.Stafford38.Stafford38.LocalizationCorollaries +public import LeanPool.Stafford38.Stafford38.LocalizedDifferentialClearing +public import LeanPool.Stafford38.Stafford38.LocalizedDifferentialCorollaries +public import LeanPool.Stafford38.Stafford38.LocalizedPolynomialCommutant +public import LeanPool.Stafford38.Stafford38.LocalizedPolynomialDerivations +public import LeanPool.Stafford38.Stafford38.LocalizedWeylAction +public import LeanPool.Stafford38.Stafford38.Ore.CoordinateStage +public import LeanPool.Stafford38.Stafford38.Ore.IteratedPairStage +public import LeanPool.Stafford38.Stafford38.Ore.LinearNormalForm +public import LeanPool.Stafford38.Stafford38.Ore.PairStage +public import LeanPool.Stafford38.Stafford38.Ore.PairUniversal +public import LeanPool.Stafford38.Stafford38.Ore.ScalarAlgebra +public import LeanPool.Stafford38.Stafford38.PaperInputs +public import LeanPool.Stafford38.Stafford38.PolynomialDifferentialOperators +public import LeanPool.Stafford38.Stafford38.PolynomialOperatorCommutators +public import LeanPool.Stafford38.Stafford38.PolynomialOperatorTaylorProjection +public import LeanPool.Stafford38.Stafford38.Quotient.EulerSurjectivity +public import LeanPool.Stafford38.Stafford38.Statement +public import LeanPool.Stafford38.Stafford38.UniversalAssembly +public import LeanPool.Stafford38.Stafford38.Weyl.AssociatedGraded +public import LeanPool.Stafford38.Stafford38.Weyl.CommutatorSymbol +public import LeanPool.Stafford38.Stafford38.Weyl.CoordinateCommutatorSymbol +public import LeanPool.Stafford38.Stafford38.Weyl.EulerRemainder +public import LeanPool.Stafford38.Stafford38.Weyl.EulerResidue +public import LeanPool.Stafford38.Stafford38.Weyl.EulerSubring +public import LeanPool.Stafford38.Stafford38.Weyl.FilteredCommutator +public import LeanPool.Stafford38.Stafford38.Weyl.FilteredScalarLifting +public import LeanPool.Stafford38.Stafford38.Weyl.Filtration +public import LeanPool.Stafford38.Stafford38.Weyl.GradedAlgebra +public import LeanPool.Stafford38.Stafford38.Weyl.IteratedEquivalence +public import LeanPool.Stafford38.Stafford38.Weyl.LeadingSymbol +public import LeanPool.Stafford38.Stafford38.Weyl.MonicNormalization +public import LeanPool.Stafford38.Stafford38.Weyl.OrderRees +public import LeanPool.Stafford38.Stafford38.Weyl.OuterOreMonic +public import LeanPool.Stafford38.Stafford38.Weyl.PBW +public import LeanPool.Stafford38.Stafford38.Weyl.PBWFirstContraction +public import LeanPool.Stafford38.Stafford38.Weyl.PBWMonicBridge +public import LeanPool.Stafford38.Stafford38.Weyl.PresentedScalarExtension +public import LeanPool.Stafford38.Stafford38.Weyl.QuotientTransport +public import LeanPool.Stafford38.Stafford38.Weyl.SymbolCompatibility +public import LeanPool.Stafford38.Stafford38.Weyl.Symplectic +public import LeanPool.Stafford38.Stafford38.Weyl.Transposition +public import LeanPool.Stafford38.Stafford38.Weyl.TranspositionFiltration +public import LeanPool.Stafford38.Stafford38.Weyl.Universal public import LeanPool.StallingsFolding public import LeanPool.StallingsFolding.BasisRose public import LeanPool.StallingsFolding.Flower diff --git a/LeanPool/Stafford38.lean b/LeanPool/Stafford38.lean new file mode 100644 index 0000000000..5039da11a4 --- /dev/null +++ b/LeanPool/Stafford38.lean @@ -0,0 +1,419 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis +public import LeanPool.Stafford38.AlgebraicAnalysis.Commutator +public import LeanPool.Stafford38.AlgebraicAnalysis.CommutatorRiccati +public import LeanPool.Stafford38.AlgebraicAnalysis.Derivation.Central +public import LeanPool.Stafford38.AlgebraicAnalysis.Derivation.Escape +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.Basic +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.CoordinateGeneration +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.LocalizedPolynomialCommutant +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.LocalizedPolynomialDerivations +public import LeanPool.Stafford38.AlgebraicAnalysis.FieldTheory.FunctionField +public import LeanPool.Stafford38.AlgebraicAnalysis.LinearAlgebra.FiniteTaylorReconstruction +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.BaseLocalizationModuleComparison +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.BaseLocalizedKoszulPositivity +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.CommutingPolynomialAction +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.DenominatorTorsion +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EndomorphismKernelSupport +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EndomorphismKernelSupportOverBase +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EscapeAssembly +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EscapeSpan +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredSchreyer +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredStrictness +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermBoundaryExhaustion +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermBoundaryNaturality +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPageActions +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPageEquivalences +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPages +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermSuccessorNaturality +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermTotalActions +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermTotalPages +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FreeSummandInduction +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.HyperplaneRestriction +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.LocalizedKernelCokernelEquivalences +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.LocalizedMinimalSupportAvoidance +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MinimalPrimeFiniteLengthLocalization +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MinimalSupportExistence +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MinimalSupportKernelCokernelLengths +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MonicAnnihilatorFinite +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulFiniteTorsion +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulMinimalSupportPositivity +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulPositivity +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulSupportOverBase +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.RankExact +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.RankTorsion +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.RightCoordinates +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.Splice +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.SplitLatticePresentation +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.StableTorsionResidualSupport +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.StablyFree +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.TorsionProjectiveImage +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.TriangularDenominator +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.TwoSimplicity +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.TwoTermPageLength +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.UniformBoundaryVanishing +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.Unimodular +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.ActiveCoordinate +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Associativity +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.IteratedPBW +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.IteratedTower +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.LeftPBW +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Localization +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.LocalizationExtension +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.PrincipalRightIdeal +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightDivision +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightHilbertBasis +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightIntersection +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightLocalization +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightPBW +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightQuotient +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Tower +public import LeanPool.Stafford38.AlgebraicAnalysis.Polynomial.DistinguishedVariable +public import LeanPool.Stafford38.AlgebraicAnalysis.RingTheory.TwoGeneratorIdentity +public import LeanPool.Stafford38.FixedSourceSolution +public import LeanPool.Stafford38.Solution +public import LeanPool.Stafford38.Stafford38 +public import LeanPool.Stafford38.Stafford38.CanonicalSupportVanishingReduction +public import LeanPool.Stafford38.Stafford38.Characteristic.ArtinianAdaptedBasisExistence +public import LeanPool.Stafford38.Stafford38.Characteristic.ArtinianAdaptedBasisTraceAdapter +public import LeanPool.Stafford38.Stafford38.Characteristic.ArtinianCoefficientField +public import LeanPool.Stafford38.Stafford38.Characteristic.ArtinianEquation33TraceProducer +public import LeanPool.Stafford38.Stafford38.Characteristic.ArtinianTriangularTrace +public import LeanPool.Stafford38.Stafford38.Characteristic.AssociatedGradedFinite +public import LeanPool.Stafford38.Stafford38.Characteristic.AssociatedGradedModule +public import LeanPool.Stafford38.Stafford38.Characteristic.BGab001CoefficientFieldTrace +public import LeanPool.Stafford38.Stafford38.Characteristic.BaseLocalizationModuleComparison +public import LeanPool.Stafford38.Stafford38.Characteristic.BaseLocalizedKoszulPositivity +public import LeanPool.Stafford38.Stafford38.Characteristic.BaseRelativePoisson +public import LeanPool.Stafford38.Stafford38.Characteristic.BaseZeroSection +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalAxisAvoidanceConsumer +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalAxisMonicInitialTop +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalBaseVariety +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalCertificate +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalFilteredGradedBridge +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalFilteredTwoTerm +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalGabberInvolutivityInterface +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalGradedTangentialEquivalences +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalKoszulContradiction +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalLaurentSymbolControl +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalMonicSaturation +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalNoncharacteristicCancellation +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalNormalAxisSupport +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalNormalSymbolFiniteness +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalOldTangentialFiniteness +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalPageEulerInequality +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalResidueExtensionSymbolControlAdapter +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalSupportAvoidanceFromCokernel +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTangentialBoundaryMaps +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTangentialPageOperators +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTangentialRingEquivalence +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTangentialSuccessors +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTangentialSymbolFiniteness +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTangentialTotalAction +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTotalGradedActionCompatibility +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalTotalGradedBridge +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalUnitCoordinatePreimage +public import LeanPool.Stafford38.Stafford38.Characteristic.CanonicalUnitPreimageFromInitialTop +public import LeanPool.Stafford38.Stafford38.Characteristic.CommutingPolynomialAction +public import LeanPool.Stafford38.Stafford38.Characteristic.ConcreteEquation33SourceMatrices +public import LeanPool.Stafford38.Stafford38.Characteristic.ConcreteInducedZAction +public import LeanPool.Stafford38.Stafford38.Characteristic.ConcreteLocalizedTwoBlockSpecialFibre +public import LeanPool.Stafford38.Stafford38.Characteristic.ConcreteSquareZeroTraceData +public import LeanPool.Stafford38.Stafford38.Characteristic.EmptySupportVanishing +public import LeanPool.Stafford38.Stafford38.Characteristic.EndomorphismKernelSupport +public import LeanPool.Stafford38.Stafford38.Characteristic.EndomorphismKernelSupportOverBase +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotient +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientGraded +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientRees +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientReesAction +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientReesExact +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientSpecialFibre +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientSupport +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredQuotientTwoJet +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermBoundaryExhaustion +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermBoundaryNaturality +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermPageActions +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermPageEquivalences +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermPages +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermSuccessorNaturality +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermTotalActions +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredTwoTermTotalPages +public import LeanPool.Stafford38.Stafford38.Characteristic.FilteredVanishing +public import LeanPool.Stafford38.Stafford38.Characteristic.GabberGlobalAssembly +public import LeanPool.Stafford38.Stafford38.Characteristic.GeometricSupportDescent +public import LeanPool.Stafford38.Stafford38.Characteristic.GeometricSupportScalarExtension +public import LeanPool.Stafford38.Stafford38.Characteristic.HomogeneousChart +public import LeanPool.Stafford38.Stafford38.Characteristic.HyperplaneRestriction +public import LeanPool.Stafford38.Stafford38.Characteristic.InitialIdeal +public import LeanPool.Stafford38.Stafford38.Characteristic.InitialIdealHomogeneous +public import LeanPool.Stafford38.Stafford38.Characteristic.LinearAction +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedHighPowerTwoBlockVanishing +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedKernelCokernelEquivalences +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedMinimalSupportAvoidance +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedOrderReesTwoJetSpecializationKernel +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedSpecializationActionCompatibility +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedTwoBlockModuleExactness +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedTwoBlockPrincipalKernelDescent +public import LeanPool.Stafford38.Stafford38.Characteristic.LocalizedTwoBlockQuotient +public import LeanPool.Stafford38.Stafford38.Characteristic.MinimalPrimeFiniteLengthLocalization +public import LeanPool.Stafford38.Stafford38.Characteristic.MinimalPrimePoisson +public import LeanPool.Stafford38.Stafford38.Characteristic.MinimalSupportExistence +public import LeanPool.Stafford38.Stafford38.Characteristic.MinimalSupportKernelCokernelLengths +public import LeanPool.Stafford38.Stafford38.Characteristic.MonicAnnihilatorFinite +public import LeanPool.Stafford38.Stafford38.Characteristic.NoncharacteristicMinimalPrime +public import LeanPool.Stafford38.Stafford38.Characteristic.NormalSymbolPolynomial +public import LeanPool.Stafford38.Stafford38.Characteristic.OrderReesTwoJet +public import LeanPool.Stafford38.Stafford38.Characteristic.OrderReesTwoJetBracket +public import LeanPool.Stafford38.Stafford38.Characteristic.OrderReesTwoJetSpecializationKernel +public import LeanPool.Stafford38.Stafford38.Characteristic.Polynomial +public import LeanPool.Stafford38.Stafford38.Characteristic.PostScalarExtensionPoisson +public import LeanPool.Stafford38.Stafford38.Characteristic.PrincipalKoszulFiniteTorsion +public import LeanPool.Stafford38.Stafford38.Characteristic.PrincipalKoszulMinimalSupportPositivity +public import LeanPool.Stafford38.Stafford38.Characteristic.PrincipalKoszulPositivity +public import LeanPool.Stafford38.Stafford38.Characteristic.PrincipalKoszulSupportOverBase +public import LeanPool.Stafford38.Stafford38.Characteristic.RadicalMinimalPrimeInvolutivity +public import LeanPool.Stafford38.Stafford38.Characteristic.ReducedSupportIdeal +public import LeanPool.Stafford38.Stafford38.Characteristic.RightReesArtinianAdapter +public import LeanPool.Stafford38.Stafford38.Characteristic.SourceActionCommutatorExpansion +public import LeanPool.Stafford38.Stafford38.Characteristic.SpecializedNoncharacteristicEquality +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroAnnihilatorBracket +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroArtinianTruncation +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroHighPowerReduction +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroLinearTrace +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroLocalizedExactness +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroLocalizedRing +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroOreLocalization +public import LeanPool.Stafford38.Stafford38.Characteristic.SquareZeroTraceData +public import LeanPool.Stafford38.Stafford38.Characteristic.StableTorsionResidualSupport +public import LeanPool.Stafford38.Stafford38.Characteristic.SymplecticCompletion +public import LeanPool.Stafford38.Stafford38.Characteristic.TransposedFilteredModuleSupport +public import LeanPool.Stafford38.Stafford38.Characteristic.TwoTermPageLength +public import LeanPool.Stafford38.Stafford38.Characteristic.UniformBoundaryVanishing +public import LeanPool.Stafford38.Stafford38.Characteristic.ZeroSectionContainment +public import LeanPool.Stafford38.Stafford38.CoordinateDifferentialGeneration +public import LeanPool.Stafford38.Stafford38.DifferentialOperators +public import LeanPool.Stafford38.Stafford38.EulerRootSeparation +public import LeanPool.Stafford38.Stafford38.EvolutionaryCertificate +public import LeanPool.Stafford38.Stafford38.EvolutionaryCorollary +public import LeanPool.Stafford38.Stafford38.FixedSourceAssembly +public import LeanPool.Stafford38.Stafford38.FixedSourceChallengeTransport +public import LeanPool.Stafford38.Stafford38.FixedSourceStatement +public import LeanPool.Stafford38.Stafford38.FoundationClosure +public import LeanPool.Stafford38.Stafford38.Geometry.AffineComponentCoordinateSplit +public import LeanPool.Stafford38.Stafford38.Geometry.AffineConormalClosure +public import LeanPool.Stafford38.Stafford38.Geometry.AffineConormalSpan +public import LeanPool.Stafford38.Stafford38.Geometry.ArcFrameConormal +public import LeanPool.Stafford38.Stafford38.Geometry.AsymptoticChartArcAdapter +public import LeanPool.Stafford38.Stafford38.Geometry.AsymptoticDivisorExistence +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalAsymptoticLaurentProducer +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalConstantCoordinateBranch +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalFiniteGradientProjectiveCoordinates +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalNonconstantFiniteGradientProduction +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalNonconstantFiniteGradientProductionProof +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalResidueExtensionAssembly +public import LeanPool.Stafford38.Stafford38.Geometry.CanonicalVisibleDivisorFrameProduction +public import LeanPool.Stafford38.Stafford38.Geometry.ChartArcAnnihilation +public import LeanPool.Stafford38.Stafford38.Geometry.CoisotropicTranslation +public import LeanPool.Stafford38.Stafford38.Geometry.CompletedDVRCoefficientSection +public import LeanPool.Stafford38.Stafford38.Geometry.CompletedDVRPowerSeriesEquiv +public import LeanPool.Stafford38.Stafford38.Geometry.ComponentFunctionFieldBoundary +public import LeanPool.Stafford38.Stafford38.Geometry.ComponentProjectiveClosure +public import LeanPool.Stafford38.Stafford38.Geometry.ComponentProjectiveClosureNormalization +public import LeanPool.Stafford38.Stafford38.Geometry.ComponentProjectiveOrder +public import LeanPool.Stafford38.Stafford38.Geometry.ConormalAxisContradiction +public import LeanPool.Stafford38.Stafford38.Geometry.ConormalPrincipalOpenDensity +public import LeanPool.Stafford38.Stafford38.Geometry.ConormalScalarExtensionVanishing +public import LeanPool.Stafford38.Stafford38.Geometry.ConstantCoordinateConormal +public import LeanPool.Stafford38.Stafford38.Geometry.ContinuousPowerSeriesTangentFrame +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorTangentLattice +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorialBoundaryExtension +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorialVisibleFrameCore +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorialVisibleFrameStage2 +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorialVisibleFrameStage4 +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorialVisibleFrameStage5 +public import LeanPool.Stafford38.Stafford38.Geometry.DivisorialVisibleFrameStageAssembly +public import LeanPool.Stafford38.Stafford38.Geometry.ExactDivisorialVisibleFrameExistence +public import LeanPool.Stafford38.Stafford38.Geometry.ExactVisibleDivisorFrameInterface +public import LeanPool.Stafford38.Stafford38.Geometry.FibreConicalVanishingIdeal +public import LeanPool.Stafford38.Stafford38.Geometry.FiniteGradientBoundaryProducer +public import LeanPool.Stafford38.Stafford38.Geometry.FiniteGradientFromTangentInclusion +public import LeanPool.Stafford38.Stafford38.Geometry.FiniteGradientResidueExtension +public import LeanPool.Stafford38.Stafford38.Geometry.FiniteSeparableDVRChartFoundation +public import LeanPool.Stafford38.Stafford38.Geometry.FixedWitnessTangentSqueeze +public import LeanPool.Stafford38.Stafford38.Geometry.FormalDivisorAxisLift +public import LeanPool.Stafford38.Stafford38.Geometry.FormalDivisorLaurentConormal +public import LeanPool.Stafford38.Stafford38.Geometry.FormalDivisorTangent +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralAsymptoticConormal +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralAsymptoticLaurentAxis +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralCoisotropicCanonicalAdapter +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralCoisotropicExclusion +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralCoisotropicSets +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralCoisotropicSetsTest +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralComponentConormalContainment +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralConormalAxis +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralConormalContainment +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralConstantCoordinateAxis +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralCoordinateAvoidance +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralDivisorialVisibleFrame +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralTangentLatticePresentation +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralTangentLimitCriterion +public import LeanPool.Stafford38.Stafford38.Geometry.GeneralTangentLimitCriterionTest +public import LeanPool.Stafford38.Stafford38.Geometry.GenericPointKaehlerConormal +public import LeanPool.Stafford38.Stafford38.Geometry.GenericSmoothOpen +public import LeanPool.Stafford38.Stafford38.Geometry.JacobianConormalComparison +public import LeanPool.Stafford38.Stafford38.Geometry.KaehlerDVRVisibility +public import LeanPool.Stafford38.Stafford38.Geometry.KaehlerSpanSeparableAdjoin +public import LeanPool.Stafford38.Stafford38.Geometry.KaehlerVisibleDerivationFrame +public import LeanPool.Stafford38.Stafford38.Geometry.LaurentConormalDirection +public import LeanPool.Stafford38.Stafford38.Geometry.LaurentConormalResidueExtension +public import LeanPool.Stafford38.Stafford38.Geometry.LocalizedProjectiveChartTransition +public import LeanPool.Stafford38.Stafford38.Geometry.NormalizationHeightOne +public import LeanPool.Stafford38.Stafford38.Geometry.OneVariableAmbientConormal +public import LeanPool.Stafford38.Stafford38.Geometry.OneVariablePrimeConormal +public import LeanPool.Stafford38.Stafford38.Geometry.PointwiseConormalContainment +public import LeanPool.Stafford38.Stafford38.Geometry.PowerSeriesArcTangency +public import LeanPool.Stafford38.Stafford38.Geometry.PowerSeriesTangentLimit +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveBoundaryFrameRank +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveConormalDehomogenization +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveConormalDirections +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveDivisorOrderGap +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveEquationFormalChart +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveTangentInclusion +public import LeanPool.Stafford38.Stafford38.Geometry.ProjectiveValuationNormalization +public import LeanPool.Stafford38.Stafford38.Geometry.RelativeCoefficientDVRPlace +public import LeanPool.Stafford38.Stafford38.Geometry.RelativeDivisorialTower +public import LeanPool.Stafford38.Stafford38.Geometry.RelativeFractionFieldTransport +public import LeanPool.Stafford38.Stafford38.Geometry.RelativeRetainedBoundaryPlace +public import LeanPool.Stafford38.Stafford38.Geometry.ResidueMinorSelection +public import LeanPool.Stafford38.Stafford38.Geometry.RetainedComponentEquationPackage +public import LeanPool.Stafford38.Stafford38.Geometry.RetainedDVRPlace +public import LeanPool.Stafford38.Stafford38.Geometry.RetainedGroundMapIdentification +public import LeanPool.Stafford38.Stafford38.Geometry.RetainedPlaceConormalTransport +public import LeanPool.Stafford38.Stafford38.Geometry.RetainedProjectiveCompletion +public import LeanPool.Stafford38.Stafford38.Geometry.RetractionSpecialization +public import LeanPool.Stafford38.Stafford38.Geometry.ScalarExtensionPoints +public import LeanPool.Stafford38.Stafford38.Geometry.SeparableResidueDerivationExtension +public import LeanPool.Stafford38.Stafford38.Geometry.SmoothAffineConormal +public import LeanPool.Stafford38.Stafford38.Geometry.SmoothConormalFibreVanishing +public import LeanPool.Stafford38.Stafford38.Geometry.SplitTangentMatrix +public import LeanPool.Stafford38.Stafford38.LeftDenominatorTransport +public import LeanPool.Stafford38.Stafford38.LeftHandedCorollary +public import LeanPool.Stafford38.Stafford38.LocalizationCorollaries +public import LeanPool.Stafford38.Stafford38.LocalizedDifferentialClearing +public import LeanPool.Stafford38.Stafford38.LocalizedDifferentialCorollaries +public import LeanPool.Stafford38.Stafford38.LocalizedPolynomialCommutant +public import LeanPool.Stafford38.Stafford38.LocalizedPolynomialDerivations +public import LeanPool.Stafford38.Stafford38.LocalizedWeylAction +public import LeanPool.Stafford38.Stafford38.Ore.CoordinateStage +public import LeanPool.Stafford38.Stafford38.Ore.IteratedPairStage +public import LeanPool.Stafford38.Stafford38.Ore.LinearNormalForm +public import LeanPool.Stafford38.Stafford38.Ore.PairStage +public import LeanPool.Stafford38.Stafford38.Ore.PairUniversal +public import LeanPool.Stafford38.Stafford38.Ore.ScalarAlgebra +public import LeanPool.Stafford38.Stafford38.PaperInputs +public import LeanPool.Stafford38.Stafford38.PolynomialDifferentialOperators +public import LeanPool.Stafford38.Stafford38.PolynomialOperatorCommutators +public import LeanPool.Stafford38.Stafford38.PolynomialOperatorTaylorProjection +public import LeanPool.Stafford38.Stafford38.Quotient.EulerSurjectivity +public import LeanPool.Stafford38.Stafford38.Statement +public import LeanPool.Stafford38.Stafford38.UniversalAssembly +public import LeanPool.Stafford38.Stafford38.Weyl.AssociatedGraded +public import LeanPool.Stafford38.Stafford38.Weyl.CommutatorSymbol +public import LeanPool.Stafford38.Stafford38.Weyl.CoordinateCommutatorSymbol +public import LeanPool.Stafford38.Stafford38.Weyl.EulerRemainder +public import LeanPool.Stafford38.Stafford38.Weyl.EulerResidue +public import LeanPool.Stafford38.Stafford38.Weyl.EulerSubring +public import LeanPool.Stafford38.Stafford38.Weyl.FilteredCommutator +public import LeanPool.Stafford38.Stafford38.Weyl.FilteredScalarLifting +public import LeanPool.Stafford38.Stafford38.Weyl.Filtration +public import LeanPool.Stafford38.Stafford38.Weyl.GradedAlgebra +public import LeanPool.Stafford38.Stafford38.Weyl.IteratedEquivalence +public import LeanPool.Stafford38.Stafford38.Weyl.LeadingSymbol +public import LeanPool.Stafford38.Stafford38.Weyl.MonicNormalization +public import LeanPool.Stafford38.Stafford38.Weyl.OrderRees +public import LeanPool.Stafford38.Stafford38.Weyl.OuterOreMonic +public import LeanPool.Stafford38.Stafford38.Weyl.PBW +public import LeanPool.Stafford38.Stafford38.Weyl.PBWFirstContraction +public import LeanPool.Stafford38.Stafford38.Weyl.PBWMonicBridge +public import LeanPool.Stafford38.Stafford38.Weyl.PresentedScalarExtension +public import LeanPool.Stafford38.Stafford38.Weyl.QuotientTransport +public import LeanPool.Stafford38.Stafford38.Weyl.SymbolCompatibility +public import LeanPool.Stafford38.Stafford38.Weyl.Symplectic +public import LeanPool.Stafford38.Stafford38.Weyl.Transposition +public import LeanPool.Stafford38.Stafford38.Weyl.TranspositionFiltration +public import LeanPool.Stafford38.Stafford38.Weyl.Universal +public import LeanPool.Stafford38.Proofs.Stafford38Reduction +public import LeanPool.Stafford38.Proofs.WeylPurePower +public import LeanPool.Stafford38.Proofs.WeylSymplectic + + +/-! +# Stafford 3.8 + +Source: url:https://github.com/itpplasma/stafford38-formal +Authors: Christopher Albert +Status: verified +Main declarations: `Stafford38.universalStatement` +Tags: weyl-algebras, noncommutative-algebra, bernstein-degree +MSC: 16S32 +-/ + + +/- +Vendored dependency provenance: + +`LeanPool/Stafford38/AlgebraicAnalysis/` adapts the separately distributed +AlgebraicAnalysis library from https://github.com/itpplasma/algebraic-analysis +at commit 4aae47967f6ba02ffe2f639ab06564c9a9d1ecc8, the dependency pinned in +https://github.com/itpplasma/stafford38-formal/blob/1e234855eee36d2541dd69580501408288760e21/lake-manifest.json. +It is distributed under Apache-2.0: +https://github.com/itpplasma/algebraic-analysis/blob/4aae47967f6ba02ffe2f639ab06564c9a9d1ecc8/LICENSE. + +Retained AlgebraicAnalysis NOTICE: + +AlgebraicAnalysis + +This project is distributed under the Apache License, Version 2.0. See +LICENSE for the complete license text. + +The package depends on Lean and Mathlib. Exact toolchain and dependency +revisions are recorded in lean-toolchain and lake-manifest.json. + +Some declarations were extracted from the historical Stafford38 development +repository under the Apache-2.0 project license. The exact source revisions, +paths, declaration mappings, and historical downstream compatibility +relationships are recorded in docs/provenance.yaml. + +Pinned dependency notice and detailed source provenance: +https://github.com/itpplasma/algebraic-analysis/blob/4aae47967f6ba02ffe2f639ab06564c9a9d1ecc8/NOTICE +https://github.com/itpplasma/algebraic-analysis/blob/4aae47967f6ba02ffe2f639ab06564c9a9d1ecc8/docs/provenance.yaml. + +Retained upstream notice: + +Copyright 2026 Christopher Albert + +This project is distributed under the Apache License, Version 2.0. The full +license text is provided in LICENSE. + +The project depends on Lean, Mathlib, and the separately distributed +AlgebraicAnalysis library. Those projects retain their own copyright notices +and licenses. + +scripts/landrun-wrapper.sh is adapted from PalomarRegistry/PalomarTemplate +at commit 128a6c5ce5f48622e69927ccd639cbff401022e8, under Apache-2.0: +https://github.com/PalomarRegistry/PalomarTemplate/blob/128a6c5ce5f48622e69927ccd639cbff401022e8/scripts/landrun-wrapper.sh +The adaptation accepts an outer command delimiter already supplied by +Comparator while preserving the rejection of unrestricted sandbox flags. + +The Stafford 3.8 manuscript, bibliography, figures, and supplements are +separate works maintained under the private Overleaf authority and licensed +CC BY 4.0. They are not included in this repository. + +-/ diff --git a/LeanPool/Stafford38/AlgebraicAnalysis.lean b/LeanPool/Stafford38/AlgebraicAnalysis.lean new file mode 100644 index 0000000000..0760c407b0 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Commutator +public import LeanPool.Stafford38.AlgebraicAnalysis.RingTheory.TwoGeneratorIdentity +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.Basic +public import LeanPool.Stafford38.AlgebraicAnalysis.CommutatorRiccati +public import LeanPool.Stafford38.AlgebraicAnalysis.FieldTheory.FunctionField +public import LeanPool.Stafford38.AlgebraicAnalysis.Polynomial.DistinguishedVariable +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.ActiveCoordinate +public import LeanPool.Stafford38.AlgebraicAnalysis.Derivation.Central +public import LeanPool.Stafford38.AlgebraicAnalysis.Derivation.Escape +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightHilbertBasis +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightIntersection +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.PrincipalRightIdeal +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Localization +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.LocalizationExtension +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.LeftPBW +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightPBW +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Tower +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.IteratedTower +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.IteratedPBW +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.RankTorsion +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.StablyFree +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.HyperplaneRestriction +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredStrictness +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.RankExact +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.DenominatorTorsion +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.TriangularDenominator +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.Unimodular +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FreeSummandInduction +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.TorsionProjectiveImage +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredSchreyer +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.Splice +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.TwoSimplicity +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EscapeSpan +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EscapeAssembly +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.RightCoordinates +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPages +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPageEquivalences +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPageActions +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermTotalPages +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermTotalActions +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermBoundaryExhaustion +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermBoundaryNaturality +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermSuccessorNaturality +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.CommutingPolynomialAction +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.BaseLocalizationModuleComparison +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.LocalizedKernelCokernelEquivalences +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.LocalizedMinimalSupportAvoidance +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MinimalPrimeFiniteLengthLocalization +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EndomorphismKernelSupport +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EndomorphismKernelSupportOverBase +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MinimalSupportKernelCokernelLengths +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulPositivity +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulFiniteTorsion +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.StableTorsionResidualSupport +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulSupportOverBase +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulMinimalSupportPositivity +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MinimalSupportExistence +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.BaseLocalizedKoszulPositivity +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.TwoTermPageLength +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.UniformBoundaryVanishing +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MonicAnnihilatorFinite +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.SplitLatticePresentation +public import LeanPool.Stafford38.AlgebraicAnalysis.LinearAlgebra.FiniteTaylorReconstruction +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.CoordinateGeneration +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.LocalizedPolynomialDerivations +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.LocalizedPolynomialCommutant +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightLocalization + + +/-! +# AlgebraicAnalysis + +Root module for reusable formal mathematics in algebraic analysis. +-/ diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Commutator.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Commutator.lean new file mode 100644 index 0000000000..5a7d92100c --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Commutator.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Algebra.Basic +public import Mathlib.Algebra.Order.Group.Nat +public import Mathlib.Algebra.Order.Sub.Basic +public import Mathlib.Tactic +public import Mathlib.Tactic.Abel + + +/-! +# Ring commutators + +This module contains the multiplication identities used by both the Weyl +symplectic layer and the differential-Ore escape layer. The convention is +`[u,v] = u*v - v*u`; no Weyl relation, Ore presentation, or application +specific structure is assumed. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis + +section + +variable {A : Type*} [Ring A] + +/-- The ring commutator, with the written multiplication order retained. -/ +def ringCommutator (u v : A) : A := u * v - v * u + +@[simp] +theorem ringCommutator_apply (u v : A) : + ringCommutator u v = u * v - v * u := rfl + +/-- Leibniz expansion in the first argument. -/ +theorem ringCommutator_mul (u v x : A) : + ringCommutator (u * v) x = + u * ringCommutator v x + ringCommutator u x * v := by + simp only [ringCommutator] + noncomm_ring + +/-- Iterated commutation with a Weyl-type relation. -/ +theorem ringCommutator_pow (z x : A) (h : ringCommutator z x = 1) : + ∀ n : ℕ, ringCommutator (z ^ n) x = n • z ^ (n - 1) + | 0 => by simp [ringCommutator] + | n + 1 => by + rw [pow_succ, ringCommutator_mul, h, ringCommutator_pow z x h n] + by_cases hn : n = 0 + · subst n + simp + · rw [smul_mul_assoc, Nat.succ_sub_one, mul_one, add_nsmul] + have hpow : z ^ (n - 1) * z = z ^ n := by + rw [← pow_succ, Nat.sub_add_cancel (Nat.pos_of_ne_zero hn)] + rw [hpow, one_nsmul] + exact add_comm _ _ + +end + +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/CommutatorRiccati.lean b/LeanPool/Stafford38/AlgebraicAnalysis/CommutatorRiccati.lean new file mode 100644 index 0000000000..174f969180 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/CommutatorRiccati.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Tactic +public import LeanPool.Stafford38.AlgebraicAnalysis.Commutator + + +/-! +# Inverse-Euler/Riccati commutator identities + +This module contains the purely ring-theoretic identities behind the +inverse-Euler calculation. No Weyl presentation, filtration, module, or +application-specific hypothesis is assumed. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.InverseEulerRiccati + +variable {A : Type*} [Ring A] + +/-- Historical local name for the shared ring commutator. -/ +def commutator (a b : A) : A := AlgebraicAnalysis.ringCommutator a b + +@[simp] +theorem commutator_eq_shared (a b : A) : + commutator a b = AlgebraicAnalysis.ringCommutator a b := rfl + +/-- Iterated commutation by a fixed element. -/ +def adIterate (p : A) : ℕ → A → A + | 0, z => z + | n + 1, z => commutator p (adIterate p n z) + +/-- Inverting the relation `P*X-X*P=-1` produces the Riccati identity. -/ +theorem inverse_riccati + (P X T : A) + (hPX : P * X - X * P = -1) + (hXT : X * T = 1) + (hTX : T * X = 1) : + P * T - T * P = T * T := by + have hright : P - X * P * T = -T := by + have h := congrArg (fun z : A => z * T) hPX + simpa [sub_mul, mul_assoc, hXT] using h + have hleft : T * P - P * T = -(T * T) := by + have htxpt : T * (X * P * T) = P * T := by + calc + T * (X * P * T) = (T * X) * P * T := by noncomm_ring + _ = P * T := by rw [hTX]; simp + calc + T * P - P * T = T * P - T * (X * P * T) := by rw [htxpt] + _ = T * (P - X * P * T) := by rw [mul_sub] + _ = T * (-T) := by rw [hright] + _ = -(T * T) := by simp + calc + P * T - T * P = -(T * P - P * T) := by noncomm_ring + _ = -(-(T * T)) := by rw [hleft] + _ = T * T := by simp + +/-- The Euler element `H = P*X` has commutator `T`. -/ +theorem euler_commutator + (P X T : A) + (hPX : P * X - X * P = -1) + (hXT : X * T = 1) + (hTX : T * X = 1) : + (P * X) * T - T * (P * X) = T := by + have htxp : T * (X * P) = P := by + calc + T * (X * P) = (T * X) * P := by rw [mul_assoc] + _ = P := by rw [hTX]; simp + have hleft : T * (P * X) - P = -T := by + calc + T * (P * X) - P = T * (P * X) - T * (X * P) := by rw [htxp] + _ = T * (P * X - X * P) := by rw [mul_sub] + _ = T * (-1) := by rw [hPX] + _ = -T := by simp + have htp : T * (P * X) = P - T := by + calc + T * (P * X) = (T * (P * X) - P) + P := by noncomm_ring + _ = (-T) + P := by rw [hleft] + _ = P - T := by noncomm_ring + calc + (P * X) * T - T * (P * X) = P - T * (P * X) := by + simp [mul_assoc, hXT] + _ = T := by rw [htp]; noncomm_ring + +private theorem commutator_nat_mul (P Z : A) (m : ℕ) : + commutator P ((m : A) * Z) = (m : A) * commutator P Z := by + have hcentral : ∀ z : A, (m : A) * z = z * (m : A) := by + intro z + exact Nat.cast_comm m z + unfold commutator + calc + P * ((m : A) * Z) - ((m : A) * Z) * P = + ((m : A) * (P * Z)) - ((m : A) * (Z * P)) := by + calc + P * ((m : A) * Z) - ((m : A) * Z) * P = + ((P * (m : A)) * Z) - ((m : A) * Z) * P := by + exact congrArg (fun q : A => q - ((m : A) * Z) * P) + (mul_assoc P (m : A) Z).symm + _ = (((m : A) * P) * Z) - ((m : A) * Z) * P := by + rw [hcentral P] + _ = (((m : A) * P) * Z) - (m : A) * (Z * P) := by + exact congrArg (fun q : A => (((m : A) * P) * Z) - q) + (mul_assoc (m : A) Z P) + _ = (m : A) * (P * Z) - (m : A) * (Z * P) := by + rw [mul_assoc] + _ = (m : A) * (P * Z - Z * P) := by rw [mul_sub] + +private theorem commutator_pow + (P T : A) + (hPT : P * T - T * P = T * T) : + ∀ n : ℕ, commutator P (T ^ n) = (n : A) * T ^ (n + 1) := by + intro n + induction n with + | zero => simp [commutator] + | succ n ih => + calc + commutator P (T ^ (n + 1)) = + commutator P (T ^ n) * T + T ^ n * commutator P T := by + simp only [commutator, AlgebraicAnalysis.ringCommutator, pow_succ] + noncomm_ring + _ = (n : A) * T ^ (n + 1) * T + + T ^ n * (P * T - T * P) := by + rw [ih] + rfl + _ = (n : A) * T ^ (n + 1) * T + T ^ n * (T * T) := by + rw [hPT] + _ = ((n + 1 : ℕ) : A) * T ^ ((n + 1) + 1) := by + rw [Nat.cast_succ] + simp only [pow_succ] + noncomm_ring + +/-- The iterated commutator is the factorial Riccati tower. -/ +theorem iterated_commutator + (P X T : A) + (hPX : P * X - X * P = -1) + (hXT : X * T = 1) + (hTX : T * X = 1) : + ∀ n : ℕ, adIterate P n T = (n.factorial : A) * T ^ (n + 1) := by + have hPT : P * T - T * P = T * T := + inverse_riccati P X T hPX hXT hTX + intro n + induction n with + | zero => simp [adIterate] + | succ n ih => + calc + adIterate P (n + 1) T = commutator P (adIterate P n T) := by rfl + _ = commutator P ((n.factorial : A) * T ^ (n + 1)) := by rw [ih] + _ = (n.factorial : A) * commutator P (T ^ (n + 1)) := by + exact commutator_nat_mul P (T ^ (n + 1)) n.factorial + _ = (n.factorial : A) * (((n + 1 : ℕ) : A) * + T ^ ((n + 1) + 1)) := by + rw [commutator_pow P T hPT (n + 1)] + _ = ((n + 1).factorial : A) * T ^ ((n + 1) + 1) := by + simp [Nat.factorial_succ, Nat.cast_succ, Nat.cast_mul, + mul_assoc, Nat.cast_comm] + + +end AlgebraicAnalysis.InverseEulerRiccati diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Derivation/Central.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Derivation/Central.lean new file mode 100644 index 0000000000..37d6f36c4a --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Derivation/Central.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Ring.Subring.Basic +public import Mathlib.Tactic + + +/-! +# Centrality and inner derivations + +This file contains the noncommutative derivation facts used by the +algebraic-analysis stages. Mathlib's `Derivation` is specialized to +commutative coefficient rings, so the Leibniz and innerness predicates are +recorded directly for additive maps on arbitrary rings. + +The fraction-presentation lemma is deliberately stated with all hypotheses +visible. It does not assert that a particular localization has those +properties. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.NoncommutativeDerivation + +variable {E : Type*} [Ring E] [Nontrivial E] + +/-- Leibniz rule for an additive derivation of a possibly noncommutative ring. -/ +def IsDerivation (d : E →+ E) : Prop := + ∀ a b : E, d (a * b) = a * d b + d a * b + +/-- An additive derivation is inner when it is a commutator with one element. -/ +def IsInnerDerivation (d : E →+ E) : Prop := + ∃ e : E, ∀ y : E, d y = e * y - y * e +theorem not_isInnerDerivation_of_central + (d : E →+ E) (x : E) + (hxcentral : ∀ y : E, x * y = y * x) (hdx : d x = 1) : + ¬ IsInnerDerivation d := by + intro hinner + obtain ⟨e, he⟩ := hinner + have h := he x + rw [hdx, hxcentral e] at h + simp at h + +omit [Nontrivial E] in +/-- Commutation with a set propagates through the subring it generates. -/ +theorem commute_of_mem_subring_closure + (x : E) (G : Set E) (hG : ∀ g ∈ G, Commute x g) : + ∀ y : E, y ∈ Subring.closure G → Commute x y := by + intro y hy + induction hy using Subring.closure_induction with + | mem z hz => exact hG z hz + | zero => exact Commute.zero_right x + | one => exact Commute.one_right x + | add a b ha hb hca hcb => exact hca.add_right hcb + | neg a ha hca => exact hca.neg_right + | mul a b ha hb hca hcb => exact hca.mul_right hcb + +omit [Nontrivial E] in +/-- +A central element of a source ring remains central in a target ring when +every target element has a right-fraction presentation and every denominator +maps to a unit. No commutativity of either ring is assumed. +-/ +theorem commute_map_of_right_fraction_representation + {R : Type*} [Ring R] + (ι : R →+* E) (x : R) + (hcentral : ∀ y : R, Commute x y) + (hunit : ∀ s : R, IsUnit (ι s)) + (hrep : ∀ z : E, ∃ c s : R, z * ι s = ι c) : + ∀ z : E, Commute (ι x) z := by + intro z + obtain ⟨c, s, hs⟩ := hrep z + apply (hunit s).mul_right_cancel + calc + (ι x * z) * ι s = ι x * (z * ι s) := by rw [mul_assoc] + _ = ι x * ι c := by rw [hs] + _ = ι (x * c) := by rw [ι.map_mul] + _ = ι (c * x) := by rw [(hcentral c).eq] + _ = ι c * ι x := by rw [ι.map_mul] + _ = (z * ι s) * ι x := by rw [hs] + _ = (z * ι x) * ι s := by + rw [mul_assoc, mul_assoc, ((hcentral s).map ι).eq] + +/-- +A derivation that sends a central coordinate to `1` cannot be inner. This is +the form consumed by differential-Ore stage arguments. +-/ +theorem not_inner_of_central_coordinate + (d : E →+ E) (_hd : IsDerivation d) (x : E) + (hxcentral : ∀ y : E, Commute x y) (hdx : d x = 1) : + ¬ IsInnerDerivation d := + not_isInnerDerivation_of_central d x (fun y => (hxcentral y).eq) hdx + + +end AlgebraicAnalysis.NoncommutativeDerivation diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Derivation/Escape.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Derivation/Escape.lean new file mode 100644 index 0000000000..db403efd6a --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Derivation/Escape.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Polynomial.Derivative +public import Mathlib.Tactic + + +/-! +# The central-coordinate escape kernel + +This file contains the part of the central-coordinate escape argument which +is independent of the later Stafford module bookkeeping. The coefficient +ring is a division ring `E`; `normal` is the coefficient-left PBW normal form +for a differential Ore extension `S`; and `commutator` is the additive map +`w ↦ w x - x w`. The only Ore-specific input needed by the kernel is the +transport identity + +`normal (derivative p) = commutator (normal p)`. + +The resulting theorem says that iterating `ad(x)` by the PBW degree produces +the nonzero scalar `d! · lc(p)`, hence a unit. The hypotheses are explicit so +that a later concrete Ore-stage file must prove the transport identity rather +than hiding it behind an axiom. + +No module-span, simplicity, denominator, or geometric statement is included: +those are separate packet obligations. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.Escape + +open Polynomial + +noncomputable section + + +variable {E S : Type*} [DivisionRing E] [Ring S] + +/-- The additive commutator map with a fixed right-hand coordinate `x`. + +The orientation is the one used in the escape argument: +`adₓ(w) = w x - x w`. +-/ +def commutator (x : S) : S →+ S where + toFun w := w * x - x * w + map_zero' := by simp + map_add' w v := by simp [add_mul, mul_add, sub_eq_add_neg, add_assoc, + add_left_comm, add_comm] + +@[simp] +theorem commutator_apply (x w : S) : + commutator x w = w * x - x * w := rfl + +/-- Correct central-coordinate PBW data for a differential Ore stage. -/ +structure CentralEscapeData where + /-- Coefficient-left normal form for the Ore stage. -/ + normal : Polynomial E ≃+ S + /-- Ring embedding of coefficients into the Ore stage. -/ + embed : E →+* S + /-- The central coefficient coordinate used by the commutator. -/ + coordinate : E + normal_C : ∀ a : E, normal (C a) = embed a + embed_isUnit : ∀ {a : E}, a ≠ 0 → IsUnit (embed a) + ad_normal_derivative : + ∀ p : Polynomial E, + commutator (embed coordinate) (normal p) = normal (derivative p) + +namespace CentralEscapeData + +variable (D : CentralEscapeData (E := E) (S := S)) + +lemma iterate_commutator_normal (p : Polynomial E) (k : ℕ) : + ((commutator (D.embed D.coordinate))^[k]) (D.normal p) = + D.normal ((derivative^[k]) p) := by + induction k with + | zero => simp + | succ k ih => + calc + ((commutator (D.embed D.coordinate))^[k.succ]) (D.normal p) = + commutator (D.embed D.coordinate) + (((commutator (D.embed D.coordinate))^[k]) (D.normal p)) := + Function.iterate_succ_apply' _ _ _ + _ = commutator (D.embed D.coordinate) (D.normal ((derivative^[k]) p)) := + congrArg (commutator (D.embed D.coordinate)) ih + _ = D.normal (derivative ((derivative^[k]) p)) := + D.ad_normal_derivative _ + _ = D.normal ((derivative^[k.succ]) p) := by + rw [Function.iterate_succ_apply'] + +lemma iterate_derivative_natDegree (p : Polynomial E) : + derivative^[p.natDegree] p = + C ((Nat.factorial p.natDegree) • p.leadingCoeff) := by + apply Polynomial.ext + intro m + by_cases hm : m = 0 + · subst m + rw [coeff_iterate_derivative] + simp only [Nat.zero_add, Nat.descFactorial_self, coeff_C_zero, + coeff_natDegree] + · have hlt : p.natDegree < m + p.natDegree := by + omega + have hcoeff : p.coeff (m + p.natDegree) = 0 := + coeff_eq_zero_of_natDegree_lt hlt + rw [coeff_iterate_derivative, hcoeff, smul_zero, coeff_C] + simp [hm] + +lemma factorial_leadingCoeff_ne_zero [CharZero E] {p : Polynomial E} (hp : p ≠ 0) : + (Nat.factorial p.natDegree) • p.leadingCoeff ≠ 0 := by + rw [nsmul_eq_mul'] + exact mul_ne_zero (leadingCoeff_ne_zero.mpr hp) + (Nat.cast_ne_zero.mpr (Nat.factorial_ne_zero _)) + +/-- Faithfulness of a differential-operator action from central-coordinate +PBW data. The action only needs to agree with left multiplication on the +coefficient embedding; iterated commutators then recover a nonzero leading +coefficient of every nonzero normal polynomial. -/ +lemma regular_action_injective [CharZero E] + (D : CentralEscapeData (E := E) (S := S)) + (action : S →+* AddMonoid.End E) + (haction : ∀ (a c : E), action (D.embed a) c = a * c) : + Function.Injective action := by + apply (injective_iff_map_eq_zero action).mpr + intro z hz + obtain ⟨p, rfl⟩ := D.normal.surjective z + have hpzero : p = 0 := by + by_contra hp + have hzero : action (D.normal p) = 0 := hz + have hiter : ∀ m : ℕ, + action (((commutator (D.embed D.coordinate))^[m]) (D.normal p)) = 0 := by + intro m + induction m with + | zero => simpa using hzero + | succ m ih => + rw [Function.iterate_succ_apply'] + simp only [commutator_apply, map_sub, map_mul, ih, + zero_mul, mul_zero, sub_zero] + have hlast := hiter p.natDegree + rw [iterate_commutator_normal D p p.natDegree, + iterate_derivative_natDegree] at hlast + have hcoeff : (Nat.factorial p.natDegree) • p.leadingCoeff = 0 := by + have hvalue := congrArg (fun f : AddMonoid.End E => f 1) hlast + rw [D.normal_C, haction] at hvalue + change (Nat.factorial p.natDegree • p.leadingCoeff) * 1 = 0 at hvalue + simpa using hvalue + exact (factorial_leadingCoeff_ne_zero hp) hcoeff + rw [hpzero] + exact D.normal.map_zero + +/-- One commutator lowers a nonconstant PBW polynomial's degree. -/ +lemma ad_degree_reduction {p : Polynomial E} + (hpositive : p.natDegree ≠ 0) : + (derivative p).natDegree < p.natDegree ∧ + commutator (D.embed D.coordinate) (D.normal p) = + D.normal (derivative p) := by + exact ⟨natDegree_derivative_lt hpositive, D.ad_normal_derivative p⟩ + +/-- Iterated `ad(x)` produces a nonzero coefficient, hence a unit. -/ +lemma ad_unit_production [CharZero E] {p : Polynomial E} (hp : p ≠ 0) : + IsUnit + (((commutator (D.embed D.coordinate))^[p.natDegree]) (D.normal p)) := by + rw [iterate_commutator_normal D, iterate_derivative_natDegree] + rw [D.normal_C] + exact D.embed_isUnit (factorial_leadingCoeff_ne_zero hp) + +end CentralEscapeData + +/-! Axiom report for the proof-critical kernel. -/ + +end +end AlgebraicAnalysis.Escape diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/Basic.lean b/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/Basic.lean new file mode 100644 index 0000000000..fb682c60b5 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/Basic.lean @@ -0,0 +1,215 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Algebra.Subalgebra.Basic + + +/-! +# Finite-order differential operators + +Neutral extraction of the intrinsic finite-order differential-operator algebra +from Stafford38 commit `1585e4c7`, originally +`Stafford38/DifferentialOperators.lean`. No Weyl presentation or +application-specific hypothesis is used. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.DifferentialOperators + +variable {k R : Type*} [CommRing k] [CommRing R] [Algebra k R] + +/-- `k`-linear endomorphisms of the `k`-algebra `R`. -/ +abbrev End := Module.End k R + +/-- Multiplication by an element of `R`, as a `k`-linear endomorphism. -/ +def multiplication (a : R) : End (k := k) (R := R) := + LinearMap.mulLeft k a + +@[simp] +theorem multiplication_apply (a x : R) : + multiplication (k := k) a x = a * x := rfl + +/-- The commutator of an endomorphism with multiplication by `a`. -/ +def commutator (P : End (k := k) (R := R)) (a : R) : End (k := k) (R := R) := + P * multiplication (k := k) a - multiplication (k := k) a * P + +@[simp] +theorem commutator_apply (P : End (k := k) (R := R)) (a x : R) : + commutator P a x = P (a * x) - a * P x := rfl + +/-- Differential operators of order at most `n`. -/ +def order : ℕ → Submodule k (End (k := k) (R := R)) + | 0 => + { carrier := {P | ∀ a, commutator P a = 0} + zero_mem' := by simp [commutator] + add_mem' := by + intro P Q hP hQ a + have heq : commutator (P + Q) a = commutator P a + commutator Q a := by + ext x + simp [commutator_apply, mul_add, sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] + calc + commutator (P + Q) a = commutator P a + commutator Q a := heq + _ = 0 := by rw [hP a, hQ a, add_zero] + smul_mem' := by + intro c P hP a + have heq : commutator (c • P) a = c • commutator P a := by + ext x + simp [commutator_apply, smul_sub] + rw [heq, hP a, smul_zero] } + | n + 1 => + { carrier := {P | ∀ a, commutator P a ∈ order n} + zero_mem' := by simp [commutator] + add_mem' := by + intro P Q hP hQ a + have heq : commutator (P + Q) a = commutator P a + commutator Q a := by + ext x + simp [commutator_apply, mul_add, sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] + rw [heq] + exact (order n).add_mem (hP a) (hQ a) + smul_mem' := by + intro c P hP a + have heq : commutator (c • P) a = c • commutator P a := by + ext x + simp [commutator_apply, smul_sub] + rw [heq] + exact (order n).smul_mem c (hP a) } + +@[simp] +theorem mem_order_zero_iff (P : End (k := k) (R := R)) : + P ∈ order (k := k) (R := R) 0 ↔ ∀ a, commutator P a = 0 := Iff.rfl + +@[simp] +theorem mem_order_succ_iff (P : End (k := k) (R := R)) (n : ℕ) : + P ∈ order (k := k) (R := R) (n + 1) ↔ + ∀ a, commutator P a ∈ order n := by + change (∀ a, commutator P a ∈ order n) ↔ _ + rfl + +theorem mem_order_zero_iff_eq_multiplication (P : End (k := k) (R := R)) : + P ∈ order (k := k) (R := R) 0 ↔ + P = multiplication (k := k) (P 1) := by + constructor + · intro h + ext a + have ha := LinearMap.congr_fun (h a) 1 + simpa [mul_comm] using sub_eq_zero.mp (by simpa [commutator_apply] using ha) + · intro hP + rw [mem_order_zero_iff] + intro a + rw [hP] + ext x + simp [commutator_apply, mul_assoc, mul_comm] + +theorem order_mono_step (n : ℕ) : + order (k := k) (R := R) n ≤ order (n + 1) := by + induction n with + | zero => + intro P hP + rw [mem_order_succ_iff] + intro a + rw [hP a] + exact (order 0).zero_mem + | succ n ih => + intro P hP + rw [mem_order_succ_iff] at hP ⊢ + intro a + exact ih (hP a) + +theorem order_mono {m n : ℕ} (h : m ≤ n) : + order (k := k) (R := R) m ≤ order n := by + induction n, h using Nat.le_induction with + | base => exact le_rfl + | succ n _ ih => exact ih.trans (order_mono_step n) + +theorem commutator_mul (P Q : End (k := k) (R := R)) (a : R) : + commutator (P * Q) a = P * commutator Q a + commutator P a * Q := by + ext x + simp [commutator_apply, Module.End.mul_apply] + +private theorem orderZero_mul {P Q : End (k := k) (R := R)} {n : ℕ} + (hP : P ∈ order (k := k) (R := R) 0) (hQ : Q ∈ order n) : + P * Q ∈ order n := by + induction n generalizing Q with + | zero => + rw [mem_order_zero_iff_eq_multiplication] at hP hQ + rw [mem_order_zero_iff] + intro a + rw [hP, hQ] + ext x + simp [commutator_apply, mul_assoc, mul_comm, mul_left_comm] + | succ n ih => + rw [mem_order_succ_iff] at hQ ⊢ + intro a + rw [commutator_mul, hP a, zero_mul, add_zero] + exact ih (hQ a) + +/-- Orders add under composition. -/ +theorem mul_mem_order {P Q : End (k := k) (R := R)} {m n : ℕ} + (hP : P ∈ order (k := k) (R := R) m) (hQ : Q ∈ order n) : + P * Q ∈ order (m + n) := by + induction m generalizing P n Q with + | zero => simpa using orderZero_mul hP hQ + | succ m ihm => + induction n generalizing P Q with + | zero => + rw [Nat.add_zero, mem_order_succ_iff] at hP ⊢ + intro a + rw [commutator_mul, hQ a, mul_zero, zero_add] + simpa using ihm (hP a) hQ + | succ n ihn => + have hQ' : Q ∈ order (n + 1) := hQ + rw [mem_order_succ_iff] at hP hQ + rw [Nat.add_succ, mem_order_succ_iff] + intro a + rw [commutator_mul] + exact (order ((m + 1) + n)).add_mem + (ihn hP (hQ a)) + (by simpa only [Nat.succ_add, Nat.add_succ] using ihm (hP a) hQ') + +/-- The algebra of all finite-order `k`-linear differential operators on `R`. -/ +def algebra : Subalgebra k (End (k := k) (R := R)) where + carrier := {P | ∃ n, P ∈ order n} + zero_mem' := ⟨0, (order 0).zero_mem⟩ + add_mem' := by + rintro P Q ⟨m, hP⟩ ⟨n, hQ⟩ + refine ⟨max m n, (order (max m n)).add_mem ?_ ?_⟩ + · exact order_mono (Nat.le_max_left _ _) hP + · exact order_mono (Nat.le_max_right _ _) hQ + mul_mem' := by + rintro P Q ⟨m, hP⟩ ⟨n, hQ⟩ + exact ⟨m + n, mul_mem_order hP hQ⟩ + one_mem' := by + refine ⟨0, (mem_order_zero_iff_eq_multiplication _).2 ?_⟩ + ext x + simp [multiplication_apply] + algebraMap_mem' := by + intro c + refine ⟨0, (mem_order_zero_iff_eq_multiplication _).2 ?_⟩ + ext x + simp [multiplication_apply] + +@[simp] +theorem mem_algebra_iff (P : End (k := k) (R := R)) : + P ∈ algebra (k := k) (R := R) ↔ ∃ n, P ∈ order n := Iff.rfl + +/-! The two basic kinds of operators are finite-order without any geometric +assumption. Keeping these witnesses public lets a concrete carrier expose +its coefficient and derivation generators through this neutral API. -/ + +/-- Multiplication by a coefficient is an intrinsic differential operator of +order zero. -/ +theorem multiplication_mem_algebra (a : R) : + multiplication (k := k) a ∈ algebra (k := k) (R := R) := by + refine ⟨0, (mem_order_zero_iff_eq_multiplication _).2 ?_⟩ + ext x + simp [multiplication_apply] + +end AlgebraicAnalysis.DifferentialOperators diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/CoordinateGeneration.lean b/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/CoordinateGeneration.lean new file mode 100644 index 0000000000..bb2d5cc1a9 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/CoordinateGeneration.lean @@ -0,0 +1,403 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.Basic +public import LeanPool.Stafford38.AlgebraicAnalysis.LinearAlgebra.FiniteTaylorReconstruction +public import Mathlib.RingTheory.Derivation.Basic + + +/-! +# Generation from coordinates and coordinate derivations + +This is the presentation-free coordinate-elimination argument. A finite +family of elements and dual derivations generates every intrinsic finite-order +differential operator, provided that commuting with all the coordinates +already characterizes multiplication operators. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.DifferentialOperators.CoordinateGeneration + + +open AlgebraicAnalysis.DifferentialOperators +open AlgebraicAnalysis.FiniteTaylorReconstruction + +noncomputable section + +variable {k R : Type*} [Field k] [CharZero k] [CommRing R] [Algebra k R] + +private def delta (x : R) : Module.End k R →ₗ[k] Module.End k R := + { toFun := fun P => commutator P x + map_add' := by + intro P Q + ext y + simp [commutator_apply, mul_add] + abel + map_smul' := by + intro c P + ext y + simp [commutator_apply, smul_sub] } + +private def rightComposition (D : Module.End k R) : + Module.End k R →ₗ[k] Module.End k R := LinearMap.mulRight k D + +omit [CharZero k] in +private lemma rightComposition_pow_apply (D : Module.End k R) + (a : ℕ) (P : Module.End k R) : + (rightComposition D ^ a) P = P * D ^ a := by + induction a with + | zero => simp [rightComposition] + | succ a ih => + rw [pow_succ', Module.End.mul_apply, ih] + simp [rightComposition, pow_succ, mul_assoc] + +omit [CharZero k] in +private lemma delta_mul (x : R) (P Q : Module.End k R) : + delta x (P * Q) = delta x P * Q + P * delta x Q := by + simpa [delta, add_comm] using commutator_mul P Q x + +omit [CharZero k] in +private lemma delta_right_derivation (x : R) (D : Derivation k R R) : + delta x D.toLinearMap = multiplication (D x) := by + ext y + simp [delta, commutator_apply, multiplication_apply, mul_comm] + +omit [CharZero k] in +private lemma deltas_commute (x y : R) (P : Module.End k R) : + delta x (delta y P) = delta y (delta x P) := by + ext z + simp [delta, commutator_apply] + ring_nf + +omit [CharZero k] in +private lemma delta_iterate_preserves_kernel (x y : R) (a : ℕ) + (P : Module.End k R) (hP : delta y P = 0) : + delta y ((delta x ^ a) P) = 0 := by + induction a with + | zero => simpa using hP + | succ a ih => + rw [pow_succ', Module.End.mul_apply] + rw [deltas_commute, ih] + exact (delta x).map_zero + +omit [CharZero k] in +private lemma right_derivation_preserves_kernel (y : R) (D : Derivation k R R) + (hxy : D y = 0) (a : ℕ) (P : Module.End k R) + (hP : delta y P = 0) : + delta y ((rightComposition D.toLinearMap ^ a) P) = 0 := by + induction a with + | zero => simpa using hP + | succ a ih => + rw [pow_succ', Module.End.mul_apply] + change delta y (rightComposition D.toLinearMap + ((rightComposition D.toLinearMap ^ a) P)) = 0 + rw [show rightComposition D.toLinearMap + ((rightComposition D.toLinearMap ^ a) P) = + (rightComposition D.toLinearMap ^ a) P * D.toLinearMap by rfl, + delta_mul, delta_right_derivation, hxy] + rw [ih, zero_mul, zero_add] + ext z + simp [multiplication_apply] + +omit [CharZero k] in +private lemma delta_mem_order {m : ℕ} (x : R) (P : Module.End k R) + (hP : P ∈ order (k := k) (R := R) (m + 1)) : + delta x P ∈ order (k := k) (R := R) m := hP x + +omit [CharZero k] in +private lemma delta_pow_order_zero (m : ℕ) (x : R) + (P : Module.End k R) (hP : P ∈ order (k := k) (R := R) m) : + (delta x ^ (m + 1)) P = 0 := by + induction m generalizing P with + | zero => + rw [pow_one] + exact hP x + | succ m ih => + rw [pow_succ, Module.End.mul_apply] + exact ih (delta x P) (delta_mem_order x P hP) + +omit [CharZero k] in +private lemma delta_pow_after_zero (x : R) (m a : ℕ) (P : Module.End k R) + (h : (delta x ^ m) P = 0) : + (delta x ^ m) ((delta x ^ a) P) = 0 := by + rw [← Module.End.mul_apply, ← pow_add] + rw [Nat.add_comm] + rw [pow_add, Module.End.mul_apply, h, map_zero] + +omit [CharZero k] in +private lemma delta_mem_algebra (x : R) (P : Module.End k R) + (hP : P ∈ algebra (k := k) (R := R)) : + delta x P ∈ algebra (k := k) (R := R) := by + rcases hP with ⟨m, hm⟩ + cases m with + | zero => + refine ⟨0, ?_⟩ + change commutator P x ∈ order 0 + rw [hm x] + exact (order 0).zero_mem + | succ m => exact ⟨m, delta_mem_order x P hm⟩ + +omit [CharZero k] in +private lemma delta_pow_mem_algebra (x : R) (a : ℕ) + (P : Module.End k R) + (hP : P ∈ algebra (k := k) (R := R)) : + (delta x ^ a) P ∈ algebra (k := k) (R := R) := by + induction a with + | zero => simpa using hP + | succ a ih => + rw [pow_succ', Module.End.mul_apply] + exact delta_mem_algebra x _ ih + +private def projection (x : R) (D : Derivation k R R) (m : ℕ) + (P : Module.End k R) : Module.End k R := + ∑ a ∈ Finset.range (m + 1), + ((-1 : k) ^ a / (a.factorial : k)) • ((delta x ^ a) P * D.toLinearMap ^ a) + +omit [CharZero k] in +private lemma projectorMapG_apply (x : R) (D : Derivation k R R) (m : ℕ) + (P : Module.End k R) : + projectorMapG m (rightComposition D.toLinearMap) (delta x) P = + projection x D m P := by + unfold projectorMapG projection + rw [LinearMap.sum_apply] + apply Finset.sum_congr rfl + intro a ha + simp only [LinearMap.smul_apply, Module.End.mul_apply] + rw [rightComposition_pow_apply] + +private lemma delta_derivation_pow (x : R) (D : Derivation k R R) + (hDx : D x = 1) : ∀ a : ℕ, + delta x (D.toLinearMap ^ a) = (a : k) • D.toLinearMap ^ (a - 1) + | 0 => by + ext y + simp [delta, commutator_apply] + | a + 1 => by + rw [pow_succ, delta_mul, delta_right_derivation, hDx, + delta_derivation_pow x D hDx a] + cases a with + | zero => + ext y + simp [multiplication_apply] + | succ a => + ext y + simp [pow_succ, add_mul, add_smul, multiplication_apply] + +private lemma projection_kernel (x : R) (D : Derivation k R R) (hDx : D x = 1) + (m : ℕ) (P : Module.End k R) + (hnil : (delta x ^ (m + 1)) P = 0) : + delta x (projection x D m P) = 0 := by + simp only [projection, map_sum] + have hterm (a : ℕ) : + delta x (((-1 : k) ^ a / (a.factorial : k)) • + ((delta x ^ a) P * D.toLinearMap ^ a)) = + ((-1 : k) ^ a / (a.factorial : k)) • + (((delta x ^ (a + 1)) P * D.toLinearMap ^ a) + + ((a : k) • ((delta x ^ a) P * D.toLinearMap ^ (a - 1)))) := by + rw [map_smul, delta_mul, delta_derivation_pow x D hDx] + rw [show delta x ((delta x ^ a) P) = (delta x ^ (a + 1)) P by + rw [pow_succ', Module.End.mul_apply]] + simp only [smul_add] + rw [mul_smul_comm, smul_smul] + simp_rw [hterm] + simp only [smul_add, Finset.sum_add_distrib] + rw [Finset.sum_range_succ, hnil] + simp only [zero_mul, smul_zero, add_zero] + rw [Finset.sum_range_succ'] + simp only [Nat.cast_zero, zero_smul] + have hcancel (a : ℕ) : + ((-1 : k) ^ a / (a.factorial : k)) • + ((delta x ^ (a + 1)) P * D.toLinearMap ^ a) + + ((-1 : k) ^ (a + 1) / ((a + 1).factorial : k)) • + ((a + 1 : k) • + ((delta x ^ (a + 1)) P * D.toLinearMap ^ a)) = 0 := by + have ha : ((a + 1 : ℕ) : k) ≠ 0 := by exact_mod_cast Nat.succ_ne_zero a + have hfac : ((a.factorial : ℕ) : k) ≠ 0 := by + exact_mod_cast Nat.factorial_ne_zero a + have hc : ((-1 : k) ^ a / (a.factorial : k)) + + ((-1 : k) ^ (a + 1) / ((a + 1).factorial : k)) * (a + 1 : k) = 0 := by + rw [Nat.factorial_succ, Nat.cast_mul, Nat.cast_succ] + field_simp [hfac, ha] + ring + rw [smul_smul, ← add_smul, hc, zero_smul] + simp only [smul_zero, add_zero] + rw [← Finset.sum_add_distrib] + apply Finset.sum_eq_zero + intro a ha + simpa [Nat.succ_sub_one] using hcancel a + +omit [CharZero k] in +private lemma projection_preserves_kernel (x y : R) (D : Derivation k R R) + (hDy : D y = 0) (m : ℕ) (P : Module.End k R) + (hP : delta y P = 0) : delta y (projection x D m P) = 0 := by + simp only [projection, map_sum, map_smul] + apply Finset.sum_eq_zero + intro a ha + rw [delta_mul] + have hpow : delta y (D.toLinearMap ^ a) = 0 := by + have h := right_derivation_preserves_kernel y D hDy a (1 : Module.End k R) + (by ext z; simp [delta, commutator_apply]) + simpa [rightComposition_pow_apply] using h + rw [delta_iterate_preserves_kernel x y a P hP, hpow] + simp + +/-! A derivation is a finite-order operator. This is exported separately from +the coordinate-generation theorem so concrete carriers can expose their +derivation generators without importing an application-specific predicate. -/ +omit [CharZero k] in +theorem derivation_mem_algebra (D : Derivation k R R) : + D.toLinearMap ∈ algebra (k := k) (R := R) := by + refine ⟨1, ?_⟩ + rw [mem_order_succ_iff] + intro r + change delta r D.toLinearMap ∈ order 0 + rw [delta_right_derivation] + apply (mem_order_zero_iff_eq_multiplication _).2 + ext z + simp [multiplication_apply] + +omit [CharZero k] in +private lemma projection_mem_algebra (x : R) (D : Derivation k R R) (m : ℕ) + (P : Module.End k R) + (hP : P ∈ algebra (k := k) (R := R)) : projection x D m P ∈ algebra := by + unfold projection + apply (algebra (k := k) (R := R)).sum_mem + intro a ha + apply (algebra (k := k) (R := R)).smul_mem + exact (algebra (k := k) (R := R)).mul_mem + (delta_pow_mem_algebra x a P hP) + ((algebra (k := k) (R := R)).pow_mem (derivation_mem_algebra D) a) + +/-- Finite-order variant: the coordinate-rigidity hypothesis is required only +for operators in `algebra`. Every intrinsic finite-order differential +operator belongs to any linear subspace containing all multiplications and +stable under right composition by a finite dual coordinate frame. No +multiplicative closure of the subspace, or commutation hypothesis among the +derivations, is required. -/ +theorem mem_submodule_of_coordinates' + {n : ℕ} (x : Fin n → R) (D : Fin n → Derivation k R R) + (hdual : ∀ i j, D i (x j) = if i = j then 1 else 0) + (hcoordinate : ∀ P : Module.End k R, P ∈ algebra (k := k) (R := R) → + (∀ i, commutator P (x i) = 0) → + P = multiplication (P 1)) + (H : Submodule k (Module.End k R)) + (hmul : ∀ r : R, multiplication r ∈ H) + (hright : ∀ i Q, Q ∈ H → Q * (D i).toLinearMap ∈ H) + (P : Module.End k R) + (hP : P ∈ algebra (k := k) (R := R)) : P ∈ H := by + have hright_pow : ∀ i a (Q : Module.End k R), Q ∈ H → + Q * (D i).toLinearMap ^ a ∈ H := by + intro i a + induction a with + | zero => + intro Q hQ + simpa using hQ + | succ a ih => + intro Q hQ + rw [pow_succ, ← mul_assoc] + exact hright i _ (ih Q hQ) + have heliminate : ∀ l : List (Fin n), l.Nodup → + (∀ Q : Module.End k R, + Q ∈ algebra (k := k) (R := R) → + (∀ i ∈ l, delta (x i) Q = 0) → Q ∈ H) → + ∀ Q : Module.End k R, + Q ∈ algebra (k := k) (R := R) → Q ∈ H := by + intro l hnod + induction l with + | nil => + intro hend Q hQ + exact hend Q hQ (by simp) + | cons i l ih => + have hinot : i ∉ l := (List.nodup_cons.mp hnod).1 + have hlnod : l.Nodup := (List.nodup_cons.mp hnod).2 + intro hend + apply ih hlnod + intro Q hQ hkern + rcases hQ with ⟨m, hm⟩ + have hnil : (delta (x i) ^ (m + 1)) Q = 0 := + delta_pow_order_zero m (x i) Q hm + rw [reconstruction_all m (rightComposition (D i).toLinearMap) + (delta (x i)) Q hnil] + apply Submodule.sum_mem + intro a ha + apply Submodule.smul_mem + rw [Module.End.mul_apply, Module.End.mul_apply, + projectorMapG_apply, rightComposition_pow_apply] + apply hright_pow + apply hend _ (projection_mem_algebra (x i) (D i) m _ + (delta_pow_mem_algebra (x i) a Q ⟨m, hm⟩)) + intro j hj + simp only [List.mem_cons] at hj + rcases hj with hji | hj + · subst j + exact projection_kernel (x i) (D i) (by simpa using hdual i i) + m _ (delta_pow_after_zero (x i) (m + 1) a Q hnil) + · have hij : i ≠ j := fun e => hinot (e ▸ hj) + apply projection_preserves_kernel (x i) (x j) (D i) + (by rw [hdual, ite_eq_right hij]) + exact delta_iterate_preserves_kernel (x i) (x j) a Q (hkern j hj) + apply heliminate (List.ofFn fun i : Fin n => i) + (List.nodup_ofFn.mpr fun _ _ h => h) ?_ P hP + intro Q hQ hkern + rw [hcoordinate Q hQ (fun i => by + simpa [delta] using hkern i (List.mem_ofFn.mpr ⟨i, rfl⟩))] + exact hmul (Q 1) + +/-- Every intrinsic finite-order differential operator belongs to any linear +subspace containing all multiplications and stable under right composition by +a finite dual coordinate frame. No multiplicative closure of the subspace, +or commutation hypothesis among the derivations, is required. -/ +theorem mem_submodule_of_coordinates + {n : ℕ} (x : Fin n → R) (D : Fin n → Derivation k R R) + (hdual : ∀ i j, D i (x j) = if i = j then 1 else 0) + (hcoordinate : ∀ P : Module.End k R, + (∀ i, commutator P (x i) = 0) → + P = multiplication (P 1)) + (H : Submodule k (Module.End k R)) + (hmul : ∀ r : R, multiplication r ∈ H) + (hright : ∀ i Q, Q ∈ H → Q * (D i).toLinearMap ∈ H) + (P : Module.End k R) + (hP : P ∈ algebra (k := k) (R := R)) : P ∈ H := + mem_submodule_of_coordinates' x D hdual (fun P _ h => hcoordinate P h) H + hmul hright P hP + +/-- Finite-order variant: the coordinate-rigidity hypothesis is required only +for operators in `algebra`. Subalgebras containing the coordinate +derivations satisfy the weaker right-stability hypothesis automatically. -/ +theorem mem_subalgebra_of_coordinates' + {n : ℕ} (x : Fin n → R) (D : Fin n → Derivation k R R) + (hdual : ∀ i j, D i (x j) = if i = j then 1 else 0) + (hcoordinate : ∀ P : Module.End k R, P ∈ algebra (k := k) (R := R) → + (∀ i, commutator P (x i) = 0) → + P = multiplication (P 1)) + (H : Subalgebra k (Module.End k R)) + (hmul : ∀ r : R, multiplication r ∈ H) + (hder : ∀ i, (D i).toLinearMap ∈ H) + (P : Module.End k R) + (hP : P ∈ algebra (k := k) (R := R)) : P ∈ H := by + apply mem_submodule_of_coordinates' x D hdual hcoordinate H.toSubmodule + hmul (fun i Q hQ => H.mul_mem hQ (hder i)) P hP + +/-- Subalgebras containing the coordinate derivations satisfy the weaker +right-stability hypothesis automatically. -/ +theorem mem_subalgebra_of_coordinates + {n : ℕ} (x : Fin n → R) (D : Fin n → Derivation k R R) + (hdual : ∀ i j, D i (x j) = if i = j then 1 else 0) + (hcoordinate : ∀ P : Module.End k R, + (∀ i, commutator P (x i) = 0) → + P = multiplication (P 1)) + (H : Subalgebra k (Module.End k R)) + (hmul : ∀ r : R, multiplication r ∈ H) + (hder : ∀ i, (D i).toLinearMap ∈ H) + (P : Module.End k R) + (hP : P ∈ algebra (k := k) (R := R)) : P ∈ H := + mem_subalgebra_of_coordinates' x D hdual (fun P _ h => hcoordinate P h) H + hmul hder P hP + +end +end AlgebraicAnalysis.DifferentialOperators.CoordinateGeneration diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/FormallyEtaleDerivations.lean b/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/FormallyEtaleDerivations.lean new file mode 100644 index 0000000000..321c1c3d45 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/FormallyEtaleDerivations.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.Etale.Kaehler + +/-! +# Derivations through formally étale algebras + +The base-change equivalence for Kähler differentials extends derivations uniquely. +Localizations and separable field extensions use this common construction. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.DifferentialOperators.FormallyEtaleDerivations + +open TensorProduct + +noncomputable section + +universe u + +variable (k A B : Type u) +variable [CommRing k] [CommRing A] [CommRing B] +variable [Algebra k A] [Algebra k B] [Algebra A B] [IsScalarTower k A B] +variable [Algebra.FormallyEtale A B] + +/-- Extend a `k`-derivation through a formally étale algebra `A → B`, by the +formally-etale base-change equivalence for Kähler differentials. -/ +noncomputable def extendDerivation + (D : Derivation k A B) : Derivation k B B := by + let base : B ⊗[A] KaehlerDifferential k A →ₗ[B] B := + D.liftKaehlerDifferential.liftBaseChange B + let pull : KaehlerDifferential k B →ₗ[B] B := + base.comp + (KaehlerDifferential.tensorKaehlerEquivOfFormallyEtale + k A B).symm.toLinearMap + exact KaehlerDifferential.linearMapEquivDerivation k B pull + +@[simp] +theorem extendDerivation_compAlgebraMap + (D : Derivation k A B) : + (extendDerivation k A B D).compAlgebraMap A = D := by + apply Derivation.ext + intro a + simp [extendDerivation, + KaehlerDifferential.tensorKaehlerEquivOfFormallyEtale_symm_D_algebraMap, + Derivation.liftKaehlerDifferential_comp_D] + +/-- A derivation of a formally étale algebra is uniquely determined by its restriction +to the original algebra. -/ +theorem derivation_ext_of_compAlgebraMap_eq + {D₁ D₂ : Derivation k B B} + (h : D₁.compAlgebraMap A = D₂.compAlgebraMap A) : + D₁ = D₂ := by + let e := KaehlerDifferential.tensorKaehlerEquivOfFormallyEtale k A B + have hbase : + (D₁.liftKaehlerDifferential.restrictScalars A).comp + (KaehlerDifferential.map k k A B) = + (D₂.liftKaehlerDifferential.restrictScalars A).comp + (KaehlerDifferential.map k k A B) := by + apply Derivation.liftKaehlerDifferential_unique + apply Derivation.ext + intro x + simpa [KaehlerDifferential.map_D, + Derivation.liftKaehlerDifferential_comp_D] using + Derivation.congr_fun h x + have hpull : + D₁.liftKaehlerDifferential.comp e.toLinearMap = + D₂.liftKaehlerDifferential.comp e.toLinearMap := by + apply LinearMap.ext + intro z + induction z using TensorProduct.inductionOn with + | add x y hx hy => simp only [map_add, hx, hy] + | tmul a x => + simp only [e, + KaehlerDifferential.tensorKaehlerEquivOfFormallyEtale_apply, + KaehlerDifferential.mapBaseChange_tmul, + LinearMap.comp_apply, LinearEquiv.coe_coe, LinearMap.map_smul] + exact congrArg (a • ·) (LinearMap.congr_fun hbase x) + apply Derivation.ext + intro x + have hmaps : D₁.liftKaehlerDifferential = D₂.liftKaehlerDifferential := by + apply LinearMap.ext + intro w + obtain ⟨z, rfl⟩ := e.surjective w + exact LinearMap.congr_fun hpull z + simpa [Derivation.liftKaehlerDifferential_comp_D] using + LinearMap.congr_fun hmaps (KaehlerDifferential.D k B x) + +end + +end AlgebraicAnalysis.DifferentialOperators.FormallyEtaleDerivations diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/LocalizedPolynomialCommutant.lean b/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/LocalizedPolynomialCommutant.lean new file mode 100644 index 0000000000..203af292ea --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/LocalizedPolynomialCommutant.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.Basic +public import Mathlib.RingTheory.Kaehler.Polynomial + + +/-! +# The polynomial commutant after localization + +An endomorphism of a localization which commutes with the coordinate +multiplications is multiplication by its value at `1`. The argument only +uses the localization presentation; it does not use a finite-order +hypothesis. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.DifferentialOperators.LocalizedPolynomialCommutant + +open AlgebraicAnalysis.DifferentialOperators + +noncomputable section + +variable {k : Type*} [CommRing k] +variable {n : ℕ} +variable (B : Type*) [CommRing B] +variable [Algebra k B] +variable (S : Submonoid (MvPolynomial (Fin n) k)) +variable [Algebra (MvPolynomial (Fin n) k) B] +variable [IsScalarTower k (MvPolynomial (Fin n) k) B] +variable [IsLocalization S B] + +theorem eq_multiplication_of_commute_coordinate + (S : Submonoid (MvPolynomial (Fin n) k)) + [IsLocalization S B] + (P : Module.End k B) + (hcoord : ∀ i : Fin n, ∀ b : B, + P (algebraMap (MvPolynomial (Fin n) k) B (MvPolynomial.X i) * b) = + algebraMap (MvPolynomial (Fin n) k) B (MvPolynomial.X i) * P b) : + P = multiplication (k := k) (P 1) := by + have hpoly : ∀ a : MvPolynomial (Fin n) k, ∀ b : B, + P (algebraMap (MvPolynomial (Fin n) k) B a * b) = + algebraMap (MvPolynomial (Fin n) k) B a * P b := by + intro a + induction a using MvPolynomial.induction_on with + | C c => + intro b + have hc : algebraMap (MvPolynomial (Fin n) k) B (MvPolynomial.C c) = + algebraMap k B c := by + calc + algebraMap (MvPolynomial (Fin n) k) B (MvPolynomial.C c) = + algebraMap (MvPolynomial (Fin n) k) B + (algebraMap k (MvPolynomial (Fin n) k) c) := by + rw [MvPolynomial.algebraMap_eq] + _ = algebraMap k B c := by + exact (IsScalarTower.algebraMap_apply k + (MvPolynomial (Fin n) k) B c).symm + rw [hc] + simpa [Algebra.smul_def] using P.map_smul c b + | add a a' ha ha' => + intro b + simp only [map_add, ha b, ha' b, add_mul] + | mul_X a i ha => + intro b + calc + P (algebraMap _ B (a * MvPolynomial.X i) * b) = + P (algebraMap (MvPolynomial (Fin n) k) B a * + (algebraMap (MvPolynomial (Fin n) k) B (MvPolynomial.X i) * b)) := by + rw [map_mul (algebraMap (MvPolynomial (Fin n) k) B)] + simp [mul_assoc] + _ = algebraMap _ B a * + P (algebraMap _ B (MvPolynomial.X i) * b) := ha _ + _ = algebraMap _ B a * + (algebraMap _ B (MvPolynomial.X i) * P b) := by + rw [hcoord] + _ = algebraMap _ B (a * MvPolynomial.X i) * P b := by + rw [map_mul (algebraMap (MvPolynomial (Fin n) k) B)] + simp [mul_assoc] + apply LinearMap.ext + intro b + obtain ⟨⟨a, s⟩, hs⟩ := IsLocalization.surj S b + have hsa : IsUnit (algebraMap (MvPolynomial (Fin n) k) B (s : _)) := + IsLocalization.map_units B s + refine hsa.mul_left_cancel ?_ + simp only [multiplication_apply] + rw [← hpoly (s : MvPolynomial (Fin n) k) b] + rw [← mul_comm b, hs] + have ha1 : P (algebraMap (MvPolynomial (Fin n) k) B a) = + algebraMap (MvPolynomial (Fin n) k) B a * P 1 := by + simpa using hpoly a 1 + rw [ha1] + rw [← hs] + simp [mul_assoc, mul_comm, mul_left_comm] + +end +end AlgebraicAnalysis.DifferentialOperators.LocalizedPolynomialCommutant diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/LocalizedPolynomialDerivations.lean b/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/LocalizedPolynomialDerivations.lean new file mode 100644 index 0000000000..6a6d78d9b8 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/DifferentialOperators/LocalizedPolynomialDerivations.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.DifferentialOperators.FormallyEtaleDerivations +public import Mathlib.RingTheory.Kaehler.Polynomial +public import Mathlib.RingTheory.Derivation.Basic + + +/-! +# Derivations through localizations + +The differentials of a localization are obtained by formally-etale base +change. This file records the resulting extension operation and its +specialization to the partial derivations of a polynomial ring. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.DifferentialOperators.LocalizedPolynomialDerivations + +open TensorProduct +open AlgebraicAnalysis.DifferentialOperators + +noncomputable section + +universe u + +variable (k A B : Type u) +variable [CommRing k] [CommRing A] [CommRing B] +variable [Algebra k A] [Algebra k B] [Algebra A B] +variable [IsScalarTower k A B] + +/-- Extend a `k`-derivation through a localization `A → B`, by the +formally-etale base-change equivalence for Kähler differentials. -/ +noncomputable def extendDerivation + (S : Submonoid A) [IsLocalization S B] + (D : Derivation k A B) : Derivation k B B := by + letI : Algebra.FormallyEtale A B := + Algebra.FormallyEtale.of_isLocalization (Rₘ := B) S + exact FormallyEtaleDerivations.extendDerivation k A B D + +@[simp] +theorem extendDerivation_compAlgebraMap + (S : Submonoid A) [IsLocalization S B] + (D : Derivation k A B) : + (extendDerivation k A B S D).compAlgebraMap A = D := by + let : Algebra.FormallyEtale A B := + Algebra.FormallyEtale.of_isLocalization (Rₘ := B) S + exact FormallyEtaleDerivations.extendDerivation_compAlgebraMap + k A B D + +/-- A derivation of a localization is uniquely determined by its restriction +to the original algebra. -/ +theorem derivation_ext_of_compAlgebraMap_eq + (S : Submonoid A) [IsLocalization S B] + {D₁ D₂ : Derivation k B B} + (h : D₁.compAlgebraMap A = D₂.compAlgebraMap A) : + D₁ = D₂ := by + let : Algebra.FormallyEtale A B := + Algebra.FormallyEtale.of_isLocalization (Rₘ := B) S + exact FormallyEtaleDerivations.derivation_ext_of_compAlgebraMap_eq + k A B h + +/-- The commutator is constructed directly because the localization argument only needs +its derivation rule, not the surrounding Lie-algebra structure. -/ +private def derivationCommutator (D E : Derivation k B B) : Derivation k B B := + Derivation.mk' (D.toLinearMap.comp E.toLinearMap - E.toLinearMap.comp D.toLinearMap) + fun a b ↦ by + simp only [LinearMap.sub_apply, LinearMap.comp_apply, Derivation.coeFn_coe, + Derivation.leibniz, map_add, smul_eq_mul] + ring + +section Polynomial + +variable {k : Type u} {n : ℕ} [Field k] + +/-- The polynomial ring in `n` coordinate variables over `k`. -/ +abbrev PolynomialRing := MvPolynomial (Fin n) k + +private theorem pderiv_comm (i j : Fin n) (f : MvPolynomial (Fin n) k) : + MvPolynomial.pderiv i (MvPolynomial.pderiv j f) = + MvPolynomial.pderiv j (MvPolynomial.pderiv i f) := by + induction f using MvPolynomial.induction_on with + | C c => simp + | add p q hp hq => simp [hp, hq] + | mul_X p l hp => + by_cases hij : i = j + · subst j + simp [ mul_comm] + · by_cases hil : i = l + · subst l + by_cases hjl : j = i + · exact False.elim (hij hjl.symm) + · simp [hp, hij, mul_comm]; ring + · by_cases hjl : j = l + · subst l + simp [hp, hil, mul_comm]; ring + · simp [hp, hil, hjl, mul_comm] + +/-- The `i`th polynomial partial derivative, transported to a localization. -/ +noncomputable def localizedPderiv + (S : Submonoid (PolynomialRing (k := k) (n := n))) + (B : Type u) [CommRing B] + [Algebra (PolynomialRing (k := k) (n := n)) B] + [Algebra k B] + [IsScalarTower k (PolynomialRing (k := k) (n := n)) B] + [IsLocalization S B] (i : Fin n) : Derivation k B B := + extendDerivation k _ B S + ((Algebra.linearMap _ B).compDer (MvPolynomial.pderiv i)) + +@[simp] +theorem localizedPderiv_compAlgebraMap + (S : Submonoid (PolynomialRing (k := k) (n := n))) + (B : Type u) [CommRing B] + [Algebra (PolynomialRing (k := k) (n := n)) B] + [Algebra k B] + [IsScalarTower k (PolynomialRing (k := k) (n := n)) B] + [IsLocalization S B] (i : Fin n) : + (localizedPderiv S B i).compAlgebraMap _ = + (Algebra.linearMap _ B).compDer (MvPolynomial.pderiv i) := by + exact extendDerivation_compAlgebraMap k _ B S _ + +theorem localizedPderiv_apply_algebraMap_X + (S : Submonoid (PolynomialRing (k := k) (n := n))) + (B : Type u) [CommRing B] + [Algebra (PolynomialRing (k := k) (n := n)) B] + [Algebra k B] + [IsScalarTower k (PolynomialRing (k := k) (n := n)) B] + [IsLocalization S B] (i j : Fin n) : + localizedPderiv S B i + (algebraMap (PolynomialRing (k := k) (n := n)) B + (MvPolynomial.X j : PolynomialRing (k := k) (n := n))) = + if i = j then 1 else 0 := by + rw [show algebraMap _ B (MvPolynomial.X j) = + (IsScalarTower.toAlgHom k _ B) (MvPolynomial.X j) by rfl] + have h := Derivation.congr_fun + (localizedPderiv_compAlgebraMap (k := k) S B i) + (MvPolynomial.X j) + change localizedPderiv S B i (algebraMap _ B (MvPolynomial.X j)) = _ at h + simpa [MvPolynomial.pderiv_X, Pi.single_apply, eq_comm] using h + +theorem localizedPderiv_comm + (S : Submonoid (PolynomialRing (k := k) (n := n))) + (B : Type u) [CommRing B] + [Algebra (PolynomialRing (k := k) (n := n)) B] + [Algebra k B] + [IsScalarTower k (PolynomialRing (k := k) (n := n)) B] + [IsLocalization S B] (i j : Fin n) : + (localizedPderiv S B i).toLinearMap.comp + (localizedPderiv S B j).toLinearMap = + (localizedPderiv S B j).toLinearMap.comp + (localizedPderiv S B i).toLinearMap := by + have hcomm : derivationCommutator k B (localizedPderiv S B i) (localizedPderiv S B j) = 0 := by + apply derivation_ext_of_compAlgebraMap_eq k _ B S + apply Derivation.ext + intro f + change localizedPderiv S B i (localizedPderiv S B j + (algebraMap _ B f)) - localizedPderiv S B j (localizedPderiv S B i + (algebraMap _ B f)) = 0 + have hi := Derivation.congr_fun + (localizedPderiv_compAlgebraMap (k := k) S B i) f + have hj := Derivation.congr_fun + (localizedPderiv_compAlgebraMap (k := k) S B j) f + change localizedPderiv S B i (algebraMap _ B f) = _ at hi + change localizedPderiv S B j (algebraMap _ B f) = _ at hj + change localizedPderiv S B i (algebraMap _ B f) = + algebraMap _ B (MvPolynomial.pderiv i f) at hi + change localizedPderiv S B j (algebraMap _ B f) = + algebraMap _ B (MvPolynomial.pderiv j f) at hj + rw [hj, hi] + have hij := Derivation.congr_fun + (localizedPderiv_compAlgebraMap (k := k) S B i) + (MvPolynomial.pderiv j f) + have hji := Derivation.congr_fun + (localizedPderiv_compAlgebraMap (k := k) S B j) + (MvPolynomial.pderiv i f) + change localizedPderiv S B i + (algebraMap _ B (MvPolynomial.pderiv j f)) = _ at hij + change localizedPderiv S B j + (algebraMap _ B (MvPolynomial.pderiv i f)) = _ at hji + change localizedPderiv S B i + (algebraMap _ B (MvPolynomial.pderiv j f)) = + algebraMap _ B (MvPolynomial.pderiv i (MvPolynomial.pderiv j f)) at hij + change localizedPderiv S B j + (algebraMap _ B (MvPolynomial.pderiv i f)) = + algebraMap _ B (MvPolynomial.pderiv j (MvPolynomial.pderiv i f)) at hji + rw [hij, hji] + rw [pderiv_comm i j f] + simp + apply LinearMap.ext + intro x + have hx := congrArg (fun d : Derivation k B B => d x) hcomm + exact sub_eq_zero.mp (by simpa [derivationCommutator, LinearMap.comp_apply] using hx) + +end Polynomial + +end +end AlgebraicAnalysis.DifferentialOperators.LocalizedPolynomialDerivations diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/FieldTheory/FunctionField.lean b/LeanPool/Stafford38/AlgebraicAnalysis/FieldTheory/FunctionField.lean new file mode 100644 index 0000000000..c5a10dcdfc --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/FieldTheory/FunctionField.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.FieldTheory.IntermediateField.Adjoin.Algebra +public import Mathlib.RingTheory.FiniteType +public import Mathlib.RingTheory.Localization.FractionRing + + +/-! +# Finitely generated fraction fields + +A fraction field of a finitely generated domain is finitely generated as a +field extension. The conclusion uses `IntermediateField.FG`, rather than +finite type as an algebra: a transcendental fraction field is generally not +finitely generated as an algebra over its ground field. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FunctionField + +noncomputable section + +universe u v w + +/-- The fraction field of a finitely generated domain is a finitely generated +field extension of the ground field. -/ +theorem top_fg_of_finiteType_fractionRing + (k : Type u) (A : Type v) (K : Type w) + [Field k] [CommRing A] [Algebra k A] + [Field K] [Algebra A K] [IsFractionRing A K] + [Algebra k K] [IsScalarTower k A K] + [Algebra.FiniteType k A] : + (⊤ : IntermediateField k K).FG := by + classical + obtain ⟨s, hs⟩ := (Algebra.FiniteType.out (R := k) (A := A)) + let f : A →ₐ[k] K := IsScalarTower.toAlgHom k A K + let fi : A ↪ K := + ⟨f, IsFractionRing.injective A K⟩ + let T : IntermediateField k K := + IntermediateField.adjoin k (f '' (s : Set A)) + have hmap : ∀ a : A, f a ∈ T := by + intro a + have ha : a ∈ Algebra.adjoin k (s : Set A) := by + rw [hs] + trivial + refine Algebra.adjoin_induction + (p := fun a _ ↦ f a ∈ T) ?_ ?_ ?_ ?_ ha + · intro x hx + exact IntermediateField.subset_adjoin k _ ⟨x, hx, rfl⟩ + · intro x + simp [f] + · intro x y _ _ hx hy + simpa using T.add_mem hx hy + · intro x y _ _ hx hy + simpa using T.mul_mem hx hy + have htop : T = ⊤ := by + rw [eq_top_iff] + intro z _ + obtain ⟨a, b, hb, hab⟩ := IsFractionRing.div_surjective (A := A) z + rw [← hab] + exact T.div_mem (hmap a) (hmap b) + refine ⟨s.map fi, ?_⟩ + simpa [T, fi, f, Finset.coe_map] using htop + + +end + +end AlgebraicAnalysis.FunctionField diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/LinearAlgebra/FiniteTaylorReconstruction.lean b/LeanPool/Stafford38/AlgebraicAnalysis/LinearAlgebra/FiniteTaylorReconstruction.lean new file mode 100644 index 0000000000..57c42f2571 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/LinearAlgebra/FiniteTaylorReconstruction.lean @@ -0,0 +1,288 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Module.LinearMap.End +public import Mathlib.Data.Nat.Factorial.Cast +public import Mathlib.Data.Nat.Choose.Basic +public import Mathlib.Tactic + + +/-! +# Finite Taylor reconstruction + +Application-independent finite Taylor reconstruction for a nilpotent +endomorphism. Extracted from Stafford38 commit c8a513d553b24c7c08da82f496c44dbbaeb1f2fc. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FiniteTaylorReconstruction + +open scoped BigOperators + +variable {𝕜 : Type*} [Field 𝕜] [CharZero 𝕜] +variable {V : Type*} [AddCommGroup V] [Module 𝕜 V] + +/-- The finite alternating Taylor projector associated with two endomorphisms. -/ +def projectorMapG (K : ℕ) (S D : V →ₗ[𝕜] V) : V →ₗ[𝕜] V := + ∑ r ∈ Finset.range (K + 1), + ((-1 : 𝕜) ^ r / (r.factorial : 𝕜)) • (S ^ r * D ^ r) + +omit [CharZero 𝕜] in +private lemma projectorMap_term_all + (K j : ℕ) (S D : V →ₗ[𝕜] V) (x : V) : + ((S ^ j * projectorMapG K S D * D ^ j) x) = + ∑ r ∈ Finset.range (K + 1), + ((-1 : 𝕜) ^ r / (r.factorial : 𝕜)) • + ((S ^ (j + r) * D ^ (j + r)) x) := by + unfold projectorMapG + simp only [Finset.mul_sum, Finset.sum_mul, + smul_mul_assoc, mul_smul_comm, Module.End.mul_apply] + rw [LinearMap.sum_apply] + apply Finset.sum_congr rfl + intro r hr + change ((-1 : 𝕜) ^ r / (r.factorial : 𝕜)) • + ((S ^ j * (S ^ r * D ^ r) * D ^ j) x) = + ((-1 : 𝕜) ^ r / (r.factorial : 𝕜)) • + ((S ^ (j + r) * D ^ (j + r)) x) + congr 1 + calc + (S ^ j * (S ^ r * D ^ r) * D ^ j) x = + ((S ^ j * S ^ r) * (D ^ r * D ^ j)) x := by + congr 1 + _ = (S ^ (j + r) * D ^ (r + j)) x := by + rw [← pow_add, ← pow_add] + _ = (S ^ (j + r) * D ^ (j + r)) x := by + rw [Nat.add_comm r j] + +private lemma triangular_reindex_all {α : Type*} [AddCommMonoid α] + (K : ℕ) (f : ℕ → ℕ → α) : + (∑ j ∈ Finset.range (K + 1), + ∑ r ∈ Finset.range (K + 1 - j), f j r) = + ∑ q ∈ Finset.range (K + 1), + ∑ j ∈ Finset.range (q + 1), f j (q - j) := by + let s : Finset (Σ _ : ℕ, ℕ) := + (Finset.range (K + 1)).sigma (fun j => Finset.range (K + 1 - j)) + let t : Finset (Σ _ : ℕ, ℕ) := + (Finset.range (K + 1)).sigma (fun q => Finset.range (q + 1)) + have hs : + (∑ j ∈ Finset.range (K + 1), + ∑ r ∈ Finset.range (K + 1 - j), f j r) = + ∑ a ∈ s, f a.1 a.2 := by + dsimp [s] + rw [Finset.sum_sigma'] + have ht : + (∑ q ∈ Finset.range (K + 1), + ∑ j ∈ Finset.range (q + 1), f j (q - j)) = + ∑ a ∈ t, f a.2 (a.1 - a.2) := by + dsimp [t] + rw [Finset.sum_sigma'] + rw [hs, ht] + apply Finset.sum_bij (fun a ha => ⟨a.1 + a.2, a.1⟩) ?_ ?_ ?_ ?_ + · intro a ha + rw [Finset.mem_sigma] at ha ⊢ + constructor + · simp only [Finset.mem_range] + have ha1 : a.1 < K + 1 := Finset.mem_range.mp ha.1 + have ha2 : a.2 < K + 1 - a.1 := Finset.mem_range.mp ha.2 + omega + · simp only [Finset.mem_range] + omega + · intro a₁ ha₁ a₂ ha₂ h + simp only [Sigma.mk.inj_iff] at h + rcases h with ⟨hsum, hfirst⟩ + have hfirst' : a₁.1 = a₂.1 := eq_of_heq hfirst + apply Sigma.ext + · exact hfirst' + · simpa [hfirst'] using (show a₁.2 = a₂.2 from by omega) + · intro b hb + rw [Finset.mem_sigma] at hb + use ⟨b.2, b.1 - b.2⟩ + have hsrc : (⟨b.2, b.1 - b.2⟩ : Σ _ : ℕ, ℕ) ∈ s := by + rw [Finset.mem_sigma] + constructor + · have hbq : b.1 < K + 1 := Finset.mem_range.mp hb.1 + have hbj : b.2 < b.1 + 1 := Finset.mem_range.mp hb.2 + simpa only [Finset.mem_range] using (show b.2 < K + 1 by omega) + · simp only [Finset.mem_range] + have hbq : b.1 < K + 1 := Finset.mem_range.mp hb.1 + have hbj : b.2 < b.1 + 1 := Finset.mem_range.mp hb.2 + omega + refine ⟨hsrc, ?_⟩ + apply Sigma.ext + · change b.2 + (b.1 - b.2) = b.1 + have hbj : b.2 ≤ b.1 := Nat.le_of_lt_succ (Finset.mem_range.mp hb.2) + omega + · simp + · intro a ha + simp + +omit [CharZero 𝕜] in +private lemma alternating_choose_sum (q : ℕ) : + (∑ j ∈ Finset.range (q + 1), + ((-1 : 𝕜) ^ (q - j) * (q.choose j : 𝕜))) = + if q = 0 then 1 else 0 := by + have h := add_pow (1 : 𝕜) (-1 : 𝕜) q + rw [show (1 : 𝕜) + (-1 : 𝕜) = 0 by norm_num] at h + simp only [one_pow, one_mul] at h + by_cases hq : q = 0 + · subst q + norm_num at h ⊢ + · simp [hq] at h ⊢ + simpa [mul_comm] using h.symm + +private lemma reciprocal_binomial_term (q j : ℕ) (hjq : j ≤ q) : + (1 / (j.factorial : 𝕜)) * + ((-1 : 𝕜) ^ (q - j) / ((q - j).factorial : 𝕜)) = + (1 / (q.factorial : 𝕜)) * + ((-1 : 𝕜) ^ (q - j) * (q.choose j : 𝕜)) := by + have hfac : q.choose j * j.factorial * (q - j).factorial = q.factorial := + Nat.choose_mul_factorial_mul_factorial hjq + have hfacQ : (q.choose j : 𝕜) * (j.factorial : 𝕜) * + ((q - j).factorial : 𝕜) = (q.factorial : 𝕜) := by + exact_mod_cast hfac + have hjfac : (j.factorial : 𝕜) ≠ 0 := by + exact_mod_cast Nat.factorial_ne_zero j + have hqfac : (q.factorial : 𝕜) ≠ 0 := by + exact_mod_cast Nat.factorial_ne_zero q + have hqjfac : ((q - j).factorial : 𝕜) ≠ 0 := by + exact_mod_cast Nat.factorial_ne_zero (q - j) + have hrec : + (1 / (j.factorial : 𝕜)) * (1 / ((q - j).factorial : 𝕜)) = + (q.choose j : 𝕜) / (q.factorial : 𝕜) := by + field_simp + rw [← hfacQ] + ring + calc + (1 / (j.factorial : 𝕜)) * + ((-1 : 𝕜) ^ (q - j) / ((q - j).factorial : 𝕜)) = + ((-1 : 𝕜) ^ (q - j)) * + ((1 / (j.factorial : 𝕜)) * (1 / ((q - j).factorial : 𝕜))) := by + ring + _ = ((-1 : 𝕜) ^ (q - j)) * + ((q.choose j : 𝕜) / (q.factorial : 𝕜)) := by rw [hrec] + _ = (1 / (q.factorial : 𝕜)) * + ((-1 : 𝕜) ^ (q - j) * (q.choose j : 𝕜)) := by ring + +private lemma reciprocal_binomial_sum (q : ℕ) : + (∑ j ∈ Finset.range (q + 1), + (1 / (j.factorial : 𝕜)) * + ((-1 : 𝕜) ^ (q - j) / ((q - j).factorial : 𝕜))) = + if q = 0 then 1 else 0 := by + rw [show (∑ j ∈ Finset.range (q + 1), + (1 / (j.factorial : 𝕜)) * + ((-1 : 𝕜) ^ (q - j) / ((q - j).factorial : 𝕜))) = + ∑ j ∈ Finset.range (q + 1), + (1 / (q.factorial : 𝕜)) * + ((-1 : 𝕜) ^ (q - j) * (q.choose j : 𝕜)) by + apply Finset.sum_congr rfl + intro j hj + exact reciprocal_binomial_term q j + (Nat.le_of_lt_succ (Finset.mem_range.mp hj))] + rw [← Finset.mul_sum] + rw [alternating_choose_sum] + by_cases hq : q = 0 + · simp [hq] + · simp [hq] + +omit [CharZero 𝕜] in +private lemma projectorMap_term_trim + (K j : ℕ) (S D : V →ₗ[𝕜] V) (x : V) + (hj : j ≤ K) (hnil : (D ^ (K + 1)) x = 0) : + ((S ^ j * projectorMapG K S D * D ^ j) x) = + ∑ r ∈ Finset.range (K + 1 - j), + ((-1 : 𝕜) ^ r / (r.factorial : 𝕜)) • + ((S ^ (j + r) * D ^ (j + r)) x) := by + rw [projectorMap_term_all] + symm + apply Finset.sum_subset + · intro r hr + exact Finset.mem_range.mpr (by + have hr' := Finset.mem_range.mp hr + omega) + · intro r hrbig hrsmall + have hrbig' := Finset.mem_range.mp hrbig + have hrsmall' : K + 1 - j ≤ r := by + exact Nat.le_of_not_gt (fun hlt => hrsmall (Finset.mem_range.mpr hlt)) + have hpow : (D ^ (j + r)) x = 0 := by + apply Module.End.pow_map_zero_of_le (m := x) (k := K + 1) (l := j + r) + · omega + · exact hnil + simp [Module.End.mul_apply, hpow] + +/-- The all-order finite Taylor reconstruction for a nilpotent derivative. -/ +theorem reconstruction_all + (K : ℕ) (S D : V →ₗ[𝕜] V) (x : V) + (hnil : (D ^ (K + 1)) x = 0) : + x = + ∑ j ∈ Finset.range (K + 1), + ((1 : 𝕜) / (j.factorial : 𝕜)) • + ((S ^ j * projectorMapG K S D * D ^ j) x) := by + have hexpand : + (∑ j ∈ Finset.range (K + 1), + ((1 : 𝕜) / (j.factorial : 𝕜)) • + ((S ^ j * projectorMapG K S D * D ^ j) x)) = + ∑ j ∈ Finset.range (K + 1), + ∑ r ∈ Finset.range (K + 1 - j), + (((1 : 𝕜) / (j.factorial : 𝕜)) * + ((-1 : 𝕜) ^ r / (r.factorial : 𝕜))) • + ((S ^ (j + r) * D ^ (j + r)) x) := by + apply Finset.sum_congr rfl + intro j hj + have hjK : j ≤ K := Nat.le_of_lt_succ (Finset.mem_range.mp hj) + rw [projectorMap_term_trim K j S D x hjK hnil] + rw [Finset.smul_sum] + apply Finset.sum_congr rfl + intro r hr + rw [smul_smul] + rw [hexpand, triangular_reindex_all] + have hreindex : + (∑ q ∈ Finset.range (K + 1), + ∑ j ∈ Finset.range (q + 1), + (((1 : 𝕜) / (j.factorial : 𝕜)) * + ((-1 : 𝕜) ^ (q - j) / ((q - j).factorial : 𝕜))) • + ((S ^ (j + (q - j)) * D ^ (j + (q - j))) x)) = + ∑ q ∈ Finset.range (K + 1), + ∑ j ∈ Finset.range (q + 1), + (((1 : 𝕜) / (j.factorial : 𝕜)) * + ((-1 : 𝕜) ^ (q - j) / ((q - j).factorial : 𝕜))) • + ((S ^ q * D ^ q) x) := by + apply Finset.sum_congr rfl + intro q hq + apply Finset.sum_congr rfl + intro j hj + have hjq : j ≤ q := Nat.le_of_lt_succ (Finset.mem_range.mp hj) + rw [Nat.add_sub_of_le hjq] + rw [hreindex] + have hcollapse : + (∑ q ∈ Finset.range (K + 1), + ∑ j ∈ Finset.range (q + 1), + (((1 : 𝕜) / (j.factorial : 𝕜)) * + ((-1 : 𝕜) ^ (q - j) / ((q - j).factorial : 𝕜))) • + ((S ^ q * D ^ q) x)) = x := by + -- The inner scalar convolution is the inverse factorial binomial sum. + -- The remaining q=0 term is exactly x; all q>0 terms are zero. + have hterm (q : ℕ) : + (∑ j ∈ Finset.range (q + 1), + (((1 : 𝕜) / (j.factorial : 𝕜)) * + ((-1 : 𝕜) ^ (q - j) / ((q - j).factorial : 𝕜))) • + ((S ^ q * D ^ q) x)) = + (if q = 0 then (1 : 𝕜) else 0) • ((S ^ q * D ^ q) x) := by + rw [← Finset.sum_smul] + rw [reciprocal_binomial_sum] + simp_rw [hterm] + simp + exact hcollapse.symm + +/-! +The following wrapper turns the endomorphism statement into the concrete +algebraic form used in a Weyl chart. It deliberately stops at the abstract +ring/module interface: the A₂-specific work of constructing `s`, proving +`D s = 1`, and proving nilpotence on the chosen element remains external. +-/ +end AlgebraicAnalysis.FiniteTaylorReconstruction diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/BaseLocalizationModuleComparison.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/BaseLocalizationModuleComparison.lean new file mode 100644 index 0000000000..66012f9f73 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/BaseLocalizationModuleComparison.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.Localization.Module +public import Mathlib.RingTheory.Localization.LocalizationLocalization + + +/-! +# Comparison of base and coefficient localizations + +For an `R`-algebra `C`, localizing a `C`-module at the image of a submonoid +`S ≤ R` agrees with localizing it as an `R`-module at `S`. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.BaseLocalizationModuleComparison + +noncomputable section + +variable {R C E : Type*} +variable [CommRing R] [CommRing C] [Algebra R C] +variable [AddCommGroup E] [Module R E] [Module C E] +variable [IsScalarTower R C E] + +variable (S : Submonoid R) + +local notation "SC" => Algebra.algebraMapSubmonoid C S + +/-- The coefficient-algebra denominator induced by a base denominator. -/ +def coefficientDenominator (s : S) : SC := + ⟨algebraMap R C s, ⟨s, s.property, rfl⟩⟩ + +local instance : IsScalarTower R C (LocalizedModule SC E) where + smul_assoc r c p := by + induction p with + | _ m s => + simp [LocalizedModule.smul'_mk, Algebra.smul_def, mul_smul, + IsScalarTower.algebraMap_smul C] + +theorem localizedModule_isLocalizedOverBase : + IsLocalizedModule S + ((LocalizedModule.mkLinearMap SC E).restrictScalars R) := by + let : IsLocalizedModule (Algebra.algebraMapSubmonoid C S) + (LocalizedModule.mkLinearMap SC E) := by + infer_instance + exact IsLocalizedModule.restrictScalars S (LocalizedModule.mkLinearMap SC E) +omit [IsScalarTower R C E] in +omit [Module R E] in +theorem localizedModule_isLocalizedOverCoefficient : + IsLocalizedModule SC (LocalizedModule.mkLinearMap SC E) := by + infer_instance + +/-- The localized coefficient module viewed over the base localization. -/ +local instance localizedBaseModule : + Module (Localization S) (LocalizedModule SC E) := + Module.compHom _ (algebraMap (Localization S) (Localization SC)) + +local instance : IsScalarTower R (Localization S) (LocalizedModule SC E) := by + constructor + intro r x p + simp only [Algebra.smul_def] + rw [mul_smul] + change algebraMap (Localization S) (Localization SC) + (algebraMap R (Localization S) r) • + algebraMap (Localization S) (Localization SC) x • p = r • + algebraMap (Localization S) (Localization SC) x • p + rw [← IsScalarTower.algebraMap_apply R (Localization S) (Localization SC), + IsScalarTower.algebraMap_smul (Localization SC)] + +/-- The canonical equivalence between base and coefficient localizations. -/ +noncomputable def localizedModuleComparison : + LocalizedModule S E ≃ₗ[Localization S] LocalizedModule SC E := + let : IsLocalizedModule S + ((LocalizedModule.mkLinearMap SC E).restrictScalars R) := + localizedModule_isLocalizedOverBase S + (IsLocalizedModule.linearEquiv S + (LocalizedModule.mkLinearMap S E) + ((LocalizedModule.mkLinearMap SC E).restrictScalars R)).extendScalarsOfIsLocalization + S (Localization S) + +theorem localizedModuleComparison_mkLinearMap (m : E) : + localizedModuleComparison S (LocalizedModule.mkLinearMap S E m) = + LocalizedModule.mkLinearMap SC E m := by + let : IsLocalizedModule S + ((LocalizedModule.mkLinearMap SC E).restrictScalars R) := + localizedModule_isLocalizedOverBase S + exact IsLocalizedModule.linearEquiv_apply S + (LocalizedModule.mkLinearMap S E) + ((LocalizedModule.mkLinearMap SC E).restrictScalars R) m + +@[simp] +theorem localizedModuleComparison_mk (m : E) (s : S) : + localizedModuleComparison S (LocalizedModule.mk m s) = + (LocalizedModule.mk m (coefficientDenominator (C := C) S s) : + LocalizedModule SC E) := by + have h : LocalizedModule.mk m s = + Localization.mk (1 : R) s • LocalizedModule.mkLinearMap S E m := by + rw [LocalizedModule.mkLinearMap_apply, LocalizedModule.mk_smul_mk] + simp + rw [h, map_smul, localizedModuleComparison_mkLinearMap] + change algebraMap (Localization S) (Localization SC) (Localization.mk 1 s) • + (LocalizedModule.mk m (1 : SC) : LocalizedModule SC E) = _ + rw [Localization.mk_eq_mk', + IsLocalization.algebraMap_mk' (R := R) (S := C) + (Rₘ := Localization S) (Sₘ := Localization SC)] + have hs : (⟨algebraMap R C s, + Algebra.mem_algebraMapSubmonoid_of_mem s⟩ : SC) = + coefficientDenominator (C := C) S s := Subtype.ext rfl + rw [map_one, hs] + rw [← Localization.mk_eq_mk', LocalizedModule.mk_smul_mk] + simp + +theorem localizedModuleComparison_natural + {F : Type*} [AddCommGroup F] [Module R F] [Module C F] + [IsScalarTower R C F] (f : E →ₗ[C] F) (x : LocalizedModule S E) : + localizedModuleComparison S + (LocalizedModule.map S (f.restrictScalars R) x) = + LocalizedModule.map SC f (localizedModuleComparison S x) := by + induction x with + | _ m s => simp + +end + +end AlgebraicAnalysis.BaseLocalizationModuleComparison diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/BaseLocalizedKoszulPositivity.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/BaseLocalizedKoszulPositivity.lean new file mode 100644 index 0000000000..4b0a76c3c6 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/BaseLocalizedKoszulPositivity.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.BaseLocalizationModuleComparison +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.LocalizedKernelCokernelEquivalences +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MinimalSupportKernelCokernelLengths +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.LocalizedMinimalSupportAvoidance +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulMinimalSupportPositivity + + +/-! +Strict positivity of the localized principal Koszul Euler characteristic over the base ring. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.BaseLocalizedKoszulPositivity + +open scoped Pointwise +open AlgebraicAnalysis +open AlgebraicAnalysis.BaseLocalizationModuleComparison +open AlgebraicAnalysis.LocalizedKernelCokernelEquivalences +open AlgebraicAnalysis.LocalizedMinimalSupportAvoidance +open AlgebraicAnalysis.PrincipalKoszulMinimalSupportPositivity + +noncomputable section + +variable {R C E : Type*} [CommRing R] [CommRing C] [Algebra R C] +variable [AddCommGroup E] [Module R E] [Module C E] [IsScalarTower R C E] +variable [IsNoetherianRing R] [IsNoetherianRing C] [Module.Finite C E] + +theorem localized_length_cokernel_gt_kernel + (x : C) + [Module.Finite R + (LinearMap.ker ((LinearMap.lsmul C E x).restrictScalars R))] + [Module.Finite R + (E ⧸ LinearMap.range ((LinearMap.lsmul C E x).restrictScalars R))] + (q : PrimeSpectrum R) + (hqmem : q ∈ Module.support R + (E ⧸ LinearMap.range ((LinearMap.lsmul C E x).restrictScalars R))) + (hqmin : ∀ p ∈ Module.support R + (E ⧸ LinearMap.range ((LinearMap.lsmul C E x).restrictScalars R)), + p.asIdeal ≤ q.asIdeal → q.asIdeal ≤ p.asIdeal) + (havoid : ∀ p ∈ (Module.annihilator C E).minimalPrimes, x ∉ p) : + Module.length (Localization q.asIdeal.primeCompl) + (LocalizedModule q.asIdeal.primeCompl + (E ⧸ LinearMap.range ((LinearMap.lsmul C E x).restrictScalars R))) > + Module.length (Localization q.asIdeal.primeCompl) + (LocalizedModule q.asIdeal.primeCompl + (LinearMap.ker ((LinearMap.lsmul C E x).restrictScalars R))) := by + let S : Submonoid R := q.asIdeal.primeCompl + let SC : Submonoid C := Algebra.algebraMapSubmonoid C S + let fC : Module.End C E := LinearMap.lsmul C E x + let fR : Module.End R E := fC.restrictScalars R + have hfinite := localized_kernel_and_cokernel_isFiniteLength fC q hqmem hqmin + have hcokerfinite : IsFiniteLength (Localization S) + (LocalizedModule S (E ⧸ LinearMap.range fR)) := by + simpa only [S, fR, fC] using hfinite.1 + have hkerfinite : IsFiniteLength (Localization S) + (LocalizedModule S (LinearMap.ker fR)) := by + simpa only [S, fR, fC] using hfinite.2 + let : Module (Localization S) (LocalizedModule SC E) := + Module.compHom _ (algebraMap (Localization S) (Localization SC)) + let : IsScalarTower (Localization S) (Localization SC) + (LocalizedModule SC E) := + IsScalarTower.of_compHom (Localization S) (Localization SC) + (LocalizedModule SC E) + let e : LocalizedModule S E ≃ₗ[Localization S] LocalizedModule SC E := + localizedModuleComparison S + let gR : Module.End (Localization S) (LocalizedModule S E) := localizedMap S fR + let y : Localization SC := algebraMap C (Localization SC) x + let gC : Module.End (Localization SC) (LocalizedModule SC E) := + LinearMap.lsmul (Localization SC) (LocalizedModule SC E) y + have heq (z : LocalizedModule S E) : e (gR z) = gC (e z) := by + rw [show e (gR z) = LocalizedModule.map SC fC (e z) by + exact localizedModuleComparison_natural S fC z] + induction e z using LocalizedModule.induction_on with + | _ m s => simp [gC, y, fC, LocalizedModule.smul'_mk] + let ek : LinearMap.ker gR ≃ₗ[Localization S] + LinearMap.ker (gC.restrictScalars (Localization S)) := + LinearEquiv.ofBijective + (e.toLinearMap.domRestrict (LinearMap.ker gR) |>.codRestrict + (LinearMap.ker (gC.restrictScalars (Localization S))) (fun z => by + exact LinearMap.mem_ker.mpr (by simpa using (heq z).symm))) + (by + constructor + · intro a b hab + exact Subtype.ext (e.injective (congrArg Subtype.val hab)) + · intro z + refine ⟨⟨e.symm z, ?_⟩, Subtype.ext (e.apply_symm_apply z)⟩ + exact LinearMap.mem_ker.mpr (e.injective (by + rw [heq] + simpa using z.property))) + have herange : Submodule.map e.toLinearMap (LinearMap.range gR) = + LinearMap.range (gC.restrictScalars (Localization S)) := by + ext z + constructor + · rintro ⟨_, ⟨a, rfl⟩, rfl⟩ + exact ⟨e a, by simpa using (heq a).symm⟩ + · rintro ⟨a, rfl⟩ + refine ⟨gR (e.symm a), ⟨e.symm a, rfl⟩, ?_⟩ + simpa using heq (e.symm a) + let ec : (LocalizedModule S E ⧸ LinearMap.range gR) ≃ₗ[Localization S] + (LocalizedModule SC E ⧸ LinearMap.range + (gC.restrictScalars (Localization S))) := + Submodule.Quotient.equiv _ _ e herange + have hnontrivBase : Nontrivial + (LocalizedModule S (E ⧸ LinearMap.range fR)) := + Module.mem_support_iff.mp (by simpa only [S, fR, fC] using hqmem) + have hnontrivCokerR : Nontrivial + (LocalizedModule S E ⧸ LinearMap.range gR) := + not_subsingleton_iff_nontrivial.mp (by + intro hs + let := hs + have : Subsingleton (LocalizedModule S (E ⧸ LinearMap.range fR)) := + (localizedCokernelEquiv S fR).toEquiv.subsingleton_congr.mpr inferInstance + exact not_subsingleton_iff_nontrivial.mpr hnontrivBase inferInstance) + have hnontrivCokerC : Nontrivial + (LocalizedModule SC E ⧸ LinearMap.range + (gC.restrictScalars (Localization S))) := + not_subsingleton_iff_nontrivial.mp (by + intro hs + exact not_subsingleton_iff_nontrivial.mpr hnontrivCokerR + (ec.toEquiv.subsingleton_congr.mpr hs)) + have hrange : LinearMap.range gC = y • (⊤ : Submodule (Localization SC) + (LocalizedModule SC E)) := by + ext z + rw [LinearMap.mem_range, Submodule.mem_smul_pointwise_iff_exists] + simp only [Submodule.mem_top, true_and] + rfl + have hnontrivQuot : Nontrivial (QuotSMulTop y (LocalizedModule SC E)) := by + change Nontrivial (LocalizedModule SC E ⧸ + y • (⊤ : Submodule (Localization SC) (LocalizedModule SC E))) + rw [← hrange] + exact hnontrivCokerC + have havoid' := localized_minimalPrime_avoids SC x havoid + have hkbase : IsFiniteLength (Localization S) (LinearMap.ker gR) := + (localizedKernelEquiv S fR).isFiniteLength hkerfinite + have hkfinite : IsFiniteLength (Localization S) + (LinearMap.ker (gC.restrictScalars (Localization S))) := + ek.isFiniteLength hkbase + have hpos := length_cokernel_gt_kernel_of_minimal_support + (R := Localization S) (C := Localization SC) (E := LocalizedModule SC E) + y havoid' hnontrivQuot hkfinite + rw [← ec.length_eq, ← (localizedCokernelEquiv S fR).length_eq, + ← ek.length_eq, ← (localizedKernelEquiv S fR).length_eq] at hpos + simpa only [S, fR, fC] using hpos + + +end +end AlgebraicAnalysis.BaseLocalizedKoszulPositivity diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/CommutingPolynomialAction.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/CommutingPolynomialAction.lean new file mode 100644 index 0000000000..3a852a61eb --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/CommutingPolynomialAction.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.MvPolynomial.Eval + + +/-! +# Polynomial actions generated by a commuting family of endomorphisms + +The target of `MvPolynomial.aeval` is required to be commutative. A family of +pairwise commuting endomorphisms therefore gives an evaluation map by first +landing in the commutative subalgebra which it generates. +-/ + +@[expose] public section + +open scoped IsMulCommutative + +namespace AlgebraicAnalysis.CommutingPolynomialAction + +universe u v w z + +variable {k : Type u} [CommRing k] +variable {V : Type v} [AddCommGroup V] [Module k V] + +private theorem range_commutative (v : σ → Module.End k V) + (hcomm : ∀ i j, Commute (v i) (v j)) : + ∀ x ∈ Set.range v, ∀ y ∈ Set.range v, x * y = y * x := by + rintro _ ⟨i, rfl⟩ _ ⟨j, rfl⟩ + exact (hcomm i j).eq + +/-- Evaluation of multivariate polynomials at a pairwise commuting family of +endomorphisms. -/ +noncomputable def commutingPolynomialAction {σ : Type w} + (v : σ → Module.End k V) + (hcomm : ∀ i j, Commute (v i) (v j)) : + MvPolynomial σ k →ₐ[k] Module.End k V := by + let S : Subalgebra k (Module.End k V) := Algebra.adjoin k (Set.range v) + letI : IsMulCommutative S := + Algebra.isMulCommutative_adjoin k (by + intro x hx y hy _ + exact range_commutative v hcomm x hx y hy) + exact + (S.val).comp + (MvPolynomial.aeval (fun i => + ⟨v i, Algebra.subset_adjoin ⟨i, rfl⟩⟩)) + +@[simp] +theorem commutingPolynomialAction_apply_X {σ : Type w} + (v : σ → Module.End k V) (hcomm : ∀ i j, Commute (v i) (v j)) (i : σ) : + commutingPolynomialAction v hcomm (MvPolynomial.X i) = v i := by + classical + simp [commutingPolynomialAction] + +/-- Evaluation sends constants to scalar endomorphisms. This named +compatibility lemma is retained even though generic algebra-hom simplification +can also discharge its left-hand side. -/ +theorem commutingPolynomialAction_apply_C {σ : Type w} + (v : σ → Module.End k V) (hcomm : ∀ i j, Commute (v i) (v j)) (a : k) : + commutingPolynomialAction v hcomm (MvPolynomial.C a) = algebraMap k (Module.End k V) a := by + classical + simp [commutingPolynomialAction] + +theorem commutingPolynomialAction_intertwines {σ : Type w} + {W : Type z} [AddCommGroup W] [Module k W] + (v : σ → Module.End k V) (w : σ → Module.End k W) + (hv : ∀ i j, Commute (v i) (v j)) + (hw : ∀ i j, Commute (w i) (w j)) + (f : V →ₗ[k] W) + (hgen : ∀ i, f.comp (v i) = (w i).comp f) (p : MvPolynomial σ k) : + f.comp (commutingPolynomialAction v hv p) = + (commutingPolynomialAction w hw p).comp f := by + classical + induction p using MvPolynomial.induction_on with + | C a => + apply LinearMap.ext + intro x + simp only [LinearMap.comp_apply, commutingPolynomialAction_apply_C] + change f (a • x) = a • f x + exact f.map_smul a x + | add p q hp hq => + rw [map_add, map_add, LinearMap.comp_add, LinearMap.add_comp, hp, hq] + | mul_X p i hp => + apply LinearMap.ext + intro x + simp only [map_mul, LinearMap.comp_apply, Module.End.mul_apply, + commutingPolynomialAction_apply_X] + calc + f ((commutingPolynomialAction v hv p) (v i x)) = + (commutingPolynomialAction w hw p) (f (v i x)) := + congrArg (fun g : V →ₗ[k] W => g (v i x)) hp + _ = (commutingPolynomialAction w hw p) (w i (f x)) := by + have hgi := congrArg (fun g : V →ₗ[k] W => g x) (hgen i) + change f (v i x) = w i (f x) at hgi + rw [hgi] + +/-- The polynomial action as a module structure on the original space. -/ +@[instance_reducible] +noncomputable def commutingPolynomialModule {σ : Type w} + (v : σ → Module.End k V) (hcomm : ∀ i j, Commute (v i) (v j)) : + Module (MvPolynomial σ k) V := + Module.compHom V (commutingPolynomialAction v hcomm).toRingHom + +end AlgebraicAnalysis.CommutingPolynomialAction diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/DenominatorTorsion.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/DenominatorTorsion.lean new file mode 100644 index 0000000000..2c3b829236 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/DenominatorTorsion.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.GroupWithZero.NonZeroDivisors +public import Mathlib.Algebra.Module.Submodule.Range +public import Mathlib.GroupTheory.OreLocalization.OreSet +public import Mathlib.LinearAlgebra.Quotient.Defs +public import Mathlib.Tactic + + +/-! +# Generic denominator clearing and torsion quotients + +This is the unconditional part of packet 9. It separates the algebraic +quotient argument from the still-unformalized triangular PBW reduction. An +explicit clearing witness for each vector implies torsion of the quotient; +the principal right-ideal case is proved directly from the opposite Ore +condition. No stage freeness or noncommutative flatness is postulated. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis +namespace DenominatorTorsion + +open nonZeroDivisors +open MulOpposite + +universe u v + +section AbstractClearance + +variable {R : Type u} [Ring R] +variable {M : Type v} [AddCommGroup M] [Module Rᵐᵒᵖ M] + +/-- Right-module torsion, with the right scalar displayed as `op s`. -/ +def IsTorsionRight : Prop := + ∀ m : M, ∃ s : R, s ≠ 0 ∧ (op s) • m = 0 + +/-- A denominator-clearing witness for a right submodule quotient. -/ +def HasDenominatorClearance (N : Submodule Rᵐᵒᵖ M) : Prop := + ∀ m : M, ∃ s : R, s ≠ 0 ∧ (op s) • m ∈ N + +theorem quotient_isTorsion_of_clearance + (N : Submodule Rᵐᵒᵖ M) + (hclear : HasDenominatorClearance (R := R) N) : + IsTorsionRight (R := R) (M := M ⧸ N) := by + intro z + refine Submodule.Quotient.induction_on N z ?_ + intro m + rcases hclear m with ⟨s, hs, hsm⟩ + refine ⟨s, hs, ?_⟩ + change N.mkQ ((op s) • m) = 0 + rw [Submodule.mkQ_apply, Submodule.Quotient.mk_eq_zero] + exact hsm + +end AbstractClearance + +section PrincipalRightIdeal + +variable {R : Type u} [Ring R] [Nontrivial R] [NoZeroDivisors R] +variable [OreLocalization.OreSet (Rᵐᵒᵖ)⁰] + +/-- Left multiplication by `q` is a right-`R`-linear map. -/ +def leftMulLinear (q : R) : R →ₗ[Rᵐᵒᵖ] R where + toFun x := q * x + map_add' x y := by + change q * (x + y) = q * x + q * y + rw [mul_add] + map_smul' a x := by + change q * (x * (unop a)) = (q * x) * (unop a) + rw [mul_assoc] + +/-- The right ideal `qR`, represented as the range of left multiplication. -/ +def principalRightIdeal (q : R) : Submodule Rᵐᵒᵖ R := + LinearMap.range (leftMulLinear q) +omit [Nontrivial R] [NoZeroDivisors R] [OreLocalization.OreSet (nonZeroDivisors Rᵐᵒᵖ)] in +theorem principalRightIdeal_mem (q x : R) : + q * x ∈ principalRightIdeal q := by + exact ⟨x, rfl⟩ + +theorem principal_quotient_isTorsion (q : R) (hq : q ≠ 0) : + IsTorsionRight (R := R) + (M := R ⧸ principalRightIdeal q) := by + intro z + refine Submodule.Quotient.induction_on (principalRightIdeal q) z ?_ + intro x + let qop : (Rᵐᵒᵖ)⁰ := + ⟨op q, mem_nonZeroDivisors_iff_ne_zero.mpr (by simpa using hq)⟩ + rcases OreLocalization.oreCondition (op x) qop with ⟨num, den, hOre⟩ + let denR : R := unop (den : Rᵐᵒᵖ) + have hOre' : x * denR = q * unop num := by + have h := congrArg unop hOre + simpa only [unop_mul, unop_op, denR, qop] using h + refine ⟨denR, ?_, ?_⟩ + · intro hden + have hden' : (den : Rᵐᵒᵖ) = 0 := by + apply unop_injective + simp [denR] at hden + exact (nonZeroDivisors.coe_ne_zero den) hden' + change (principalRightIdeal q).mkQ ((op denR) • x) = 0 + rw [Submodule.mkQ_apply, Submodule.Quotient.mk_eq_zero] + refine ⟨unop num, ?_⟩ + change q * unop num = x * denR + exact hOre'.symm + +end PrincipalRightIdeal + + +end DenominatorTorsion +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/EndomorphismKernelSupport.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/EndomorphismKernelSupport.lean new file mode 100644 index 0000000000..acee9a8ae7 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/EndomorphismKernelSupport.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.Support +public import Mathlib.RingTheory.Noetherian.Orzech + + +/-! +# Kernel support is contained in cokernel support + +The only input is the Hopfian property of a finite module over a commutative +Noetherian ring. The proof is deliberately made at a prime, using the +actual `LocalizedModule` support definition. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis + +theorem endomorphism_kernel_support_subset_cokernel_support + {R E : Type*} [CommRing R] [AddCommGroup E] [Module R E] + [IsNoetherianRing R] [Module.Finite R E] (f : Module.End R E) : + Module.support R (LinearMap.ker f) ⊆ + Module.support R (E ⧸ LinearMap.range f) := by + intro p hp + rw [Module.mem_support_iff'] at hp ⊢ + by_contra h + have hnot : p ∉ Module.support R (E ⧸ LinearMap.range f) := by + rw [Module.mem_support_iff'] + exact h + have h := Module.notMem_support_iff.mp hnot + have hsurj : Function.Surjective + (LocalizedModule.map p.asIdeal.primeCompl f) := + (LinearMap.localizedMap_surjective_iff_subsingleton_localized_coker + p.asIdeal.primeCompl f).2 h + let : IsNoetherian (Localization p.asIdeal.primeCompl) + (LocalizedModule p.asIdeal.primeCompl E) := by infer_instance + have hinj : Function.Injective + (LocalizedModule.map p.asIdeal.primeCompl f) := + IsNoetherian.injective_of_surjective_endomorphism _ hsurj + obtain ⟨x, hx⟩ := hp + let x' : LocalizedModule p.asIdeal.primeCompl E := + LocalizedModule.mk x.1 1 + have hxzero : x' = 0 := by + apply hinj + dsimp [x'] + rw [LocalizedModule.map_mk] + simp [LinearMap.mem_ker.mp x.2] + have hxzero' : + IsLocalizedModule.mk' (LocalizedModule.mkLinearMap p.asIdeal.primeCompl E) + x.1 (1 : p.asIdeal.primeCompl) = 0 := by + rw [← IsLocalizedModule.mk_eq_mk'] + exact hxzero + obtain ⟨s, hs⟩ := + (IsLocalizedModule.mk'_eq_zero' + (LocalizedModule.mkLinearMap p.asIdeal.primeCompl E) (1 : p.asIdeal.primeCompl)).mp + hxzero' + have hs' : (s.1 : R) • x = 0 := by + apply Subtype.ext + exact hs + exact hx s.1 s.2 hs' + +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/EndomorphismKernelSupportOverBase.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/EndomorphismKernelSupportOverBase.lean new file mode 100644 index 0000000000..a8d3ac9863 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/EndomorphismKernelSupportOverBase.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EndomorphismKernelSupport +public import Mathlib.RingTheory.Ideal.Maps + + +/-! +# Kernel support over a base ring + +A finite module over a commutative Noetherian coefficient algebra is Hopfian +over that algebra. This gives the kernel--cokernel support inclusion after +restriction of scalars, without assuming finite generation over the base. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis + +theorem endomorphism_kernel_support_subset_cokernel_support_over_base + {R C E : Type*} [CommRing R] [CommRing C] [Algebra R C] + [AddCommGroup E] [Module C E] [Module R E] [IsScalarTower R C E] + [IsNoetherianRing C] [Module.Finite C E] (f : Module.End C E) : + Module.support R (LinearMap.ker (f.restrictScalars R)) ⊆ + Module.support R (E ⧸ LinearMap.range (f.restrictScalars R)) := by + intro p hp + rw [Module.mem_support_iff_exists_annihilator] at hp ⊢ + obtain ⟨x, hx⟩ := hp + let xC : LinearMap.ker f := ⟨x.1, by + exact x.2⟩ + let I : Ideal C := (C ∙ xC).annihilator + have hdisj : Disjoint (I : Set C) (p.asIdeal.primeCompl.map (algebraMap R C)) := by + rw [Set.disjoint_left] + rintro c hc ⟨r, hr, rfl⟩ + have hc' : algebraMap R C r • xC.1 = 0 := by + have hcx : algebraMap R C r • xC = 0 := by + exact (Submodule.mem_annihilator_span_singleton _ _).mp hc + exact congrArg Subtype.val hcx + have hrx : r • x = 0 := by + apply Subtype.ext + change r • x.1 = 0 + simpa [xC, IsScalarTower.algebraMap_smul C r x.1] using hc' + have hrann : r ∈ (R ∙ x).annihilator := by + exact (Submodule.mem_annihilator_span_singleton _ _).mpr hrx + exact hr (hx hrann) + obtain ⟨q, hqprime, hIq, hqdisj⟩ := I.exists_le_prime_disjoint _ hdisj + let q' : PrimeSpectrum C := ⟨q, hqprime⟩ + have hxC : q' ∈ Module.support C (LinearMap.ker f) := by + rw [Module.mem_support_iff_exists_annihilator] + exact ⟨xC, show (C ∙ xC).annihilator ≤ q from hIq⟩ + have hcokerC : q' ∈ Module.support C (E ⧸ LinearMap.range f) := + endomorphism_kernel_support_subset_cokernel_support f hxC + obtain ⟨y, hy⟩ := Module.mem_support_iff_exists_annihilator.mp hcokerC + refine ⟨y, ?_⟩ + intro r hr + have hmap : algebraMap R C r ∈ (C ∙ y).annihilator := by + rw [Submodule.mem_annihilator_span_singleton] + have hry : r • y = 0 := + (Submodule.mem_annihilator_span_singleton _ _).mp hr + simpa [IsScalarTower.algebraMap_smul C r y] using hry + by_contra hrp + exact Set.disjoint_left.mp hqdisj (hy hmap) ⟨r, hrp, rfl⟩ + + +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/EscapeAssembly.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/EscapeAssembly.lean new file mode 100644 index 0000000000..75b15dd544 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/EscapeAssembly.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EscapeSpan + + +/-! +# Finite-tuple central-coordinate escape + +This is the finite-dimensional algebraic part of packet 7. A tuple of +coefficient-left PBW terms with strictly decreasing active degrees is assumed +to lie in a right `S`-submodule. If the submodule is also closed under left +multiplication by the central coordinate, the commutator iterates isolate +one coordinate at a time. `Escape.ad_unit_production` supplies the unit at +the selected coordinate, and the right-module lemma in `EscapeSpan` then +gives the whole free module. + +The theorem deliberately stops at this local span result. It does not claim +that a global Stafford correction family supplies the hypotheses. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.EscapeAssembly + +open AlgebraicAnalysis.Escape +open AlgebraicAnalysis.EscapeSpan + +noncomputable section + +open scoped BigOperators +open Polynomial + +variable {E S : Type*} [DivisionRing E] [CharZero E] [Ring S] +variable {n : ℕ} + +lemma iterate_commutatorVector_mem + (H : Submodule Sᵐᵒᵖ (Fin n → S)) (x : S) + (hleft : ∀ v : Fin n → S, v ∈ H → (fun i => x * v i) ∈ H) + {v : Fin n → S} (hv : v ∈ H) (k : ℕ) : + (commutatorVector x)^[k] v ∈ H := by + induction k with + | zero => simpa using hv + | succ k ih => + rw [Function.iterate_succ_apply'] + exact commutatorVector_mem H x hleft ih + +/-- Coordinates whose index is below the current active degree. -/ +def knownCoordinates (m : ℕ) : Finset (Fin n) := + Finset.univ.filter (fun j => j.val < m) + +/-- Remove the currently known coordinate contributions from a vector. -/ +def residualVector (v : Fin n → S) (m : ℕ) : Fin n → S := + v - ∑ j ∈ knownCoordinates m, Pi.single j (v j) + +lemma residualVector_apply_lt (v : Fin n → S) (m : ℕ) + {j : Fin n} (hj : j.val < m) : residualVector v m j = 0 := by + classical + simp only [residualVector, Pi.sub_apply] + have hmem : j ∈ knownCoordinates m := by simp [knownCoordinates, hj] + have hsum : + (∑ k ∈ knownCoordinates m, + (Pi.single k (v k) : Fin n → S)) j = v j := by + rw [Finset.sum_apply] + rw [Finset.sum_eq_single j] + · simp + · intro b hb hbj + simp [Ne.symm hbj] + · intro hjnot + exact (hjnot hmem).elim + rw [hsum, sub_self] + +lemma residualVector_apply_not_lt (v : Fin n → S) (m : ℕ) + {j : Fin n} (hj : ¬ j.val < m) : residualVector v m j = v j := by + classical + simp only [residualVector, Pi.sub_apply] + have hsum : + (∑ k ∈ knownCoordinates m, + (Pi.single k (v k) : Fin n → S)) j = 0 := by + rw [Finset.sum_apply] + apply Finset.sum_eq_zero + intro k hk + have hkj : k ≠ j := by + intro hEq + subst j + exact hj (by simpa [knownCoordinates] using hk) + simp [hkj] + rw [hsum, sub_zero] + +/-- +The actual finite-tuple escape theorem. The only analytic-looking input is +the PBW transport packaged by `CentralEscapeData`; all module operations are +right-sided through `Sᵐᵒᵖ`. +-/ +theorem finite_tuple_escape + (D : CentralEscapeData (E := E) (S := S)) + (p : Fin n → Polynomial E) + (hp : ∀ i, p i ≠ 0) + (hstrict : StrictAnti (fun i => (p i).natDegree)) + (H : Submodule Sᵐᵒᵖ (Fin n → S)) + (hv : (fun i => D.normal (p i)) ∈ H) + (hleft : ∀ v : Fin n → S, v ∈ H → + (fun i => D.embed D.coordinate * v i) ∈ H) : + H = ⊤ := by + let v : Fin n → S := fun i => D.normal (p i) + have hv' : v ∈ H := hv + have hpure : ∀ i : Fin n, ∃ u : S, IsUnit u ∧ + (Pi.single i u : Fin n → S) ∈ H := by + have hprocess : ∀ m : ℕ, m ≤ n → + ∀ j : Fin n, j.val < m → ∃ u : S, IsUnit u ∧ + (Pi.single j u : Fin n → S) ∈ H := by + intro m hm + induction m with + | zero => + intro j hj + omega + | succ m ih => + have hm' : m < n := by omega + let i : Fin n := ⟨m, hm'⟩ + have hprior : ∀ j : Fin n, j.val < m → ∃ u : S, IsUnit u ∧ + (Pi.single j u : Fin n → S) ∈ H := by + intro j hj + exact ih (by omega) j hj + have hsum : + (∑ j ∈ knownCoordinates m, (Pi.single j (v j) : Fin n → S)) ∈ H := by + apply H.sum_mem + intro j hj + have hjlt : j.val < m := by + simpa [knownCoordinates] using hj + obtain ⟨u, hu, huH⟩ := hprior j hjlt + exact single_mem_of_unit_single_mem H j hu huH (v j) + have hres : residualVector v m ∈ H := + H.sub_mem hv' hsum + have hzmem : + (commutatorVector (D.embed D.coordinate))^[((p i).natDegree)] + (residualVector v m) ∈ H := + iterate_commutatorVector_mem H (D.embed D.coordinate) hleft hres _ + let z : Fin n → S := + (commutatorVector (D.embed D.coordinate))^[((p i).natDegree)] + (residualVector v m) + have hzi : IsUnit (z i) := by + dsimp [z] + rw [commutatorVector_iterate_apply] + rw [residualVector_apply_not_lt] + · simpa [v] using D.ad_unit_production (hp i) + · exact Nat.not_lt_of_ge (Nat.le_refl m) + have hzj : ∀ j : Fin n, j ≠ i → z j = 0 := by + intro j hji + by_cases hjlt : j.val < m + · dsimp [z] + rw [commutatorVector_iterate_apply, + residualVector_apply_lt v m hjlt] + simp + · have hjval : j.val ≠ m := by + intro hEq + apply hji + apply Fin.ext + exact hEq + have hmj : m < j.val := by omega + have hij : i < j := by + exact Fin.mk_lt_mk.mpr hmj + have hdeg : (p j).natDegree < (p i).natDegree := + hstrict hij + have hzero : + (derivative^[((p i).natDegree)]) (p j) = 0 := + iterate_derivative_eq_zero hdeg + dsimp [z] + rw [commutatorVector_iterate_apply, + residualVector_apply_not_lt v m hjlt] + rw [D.iterate_commutator_normal, hzero] + simp + have hzpure : z = Pi.single i (z i) := by + funext j + by_cases hji : i = j + · subst j + simp + · rw [hzj j (Ne.symm hji)] + simp [hji] + have hpure_i : (Pi.single i (z i) : Fin n → S) ∈ H := by + rw [← hzpure] + exact hzmem + intro j hj + by_cases hEq : j.val = m + · have hji : j = i := by + apply Fin.ext + exact hEq + subst j + exact ⟨z i, hzi, hpure_i⟩ + · have hjlt : j.val < m := by omega + exact hprior j hjlt + intro i + have hi : i.val + 1 ≤ n := by exact i.isLt.succ_le + exact hprocess (i.val + 1) hi i (by simp) + exact top_of_unit_singletons H hpure + + +end +end AlgebraicAnalysis.EscapeAssembly diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/EscapeSpan.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/EscapeSpan.lean new file mode 100644 index 0000000000..0fd467c094 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/EscapeSpan.lean @@ -0,0 +1,141 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Derivation.Escape + + +/-! +# Right-sided span consequences of escape + +The preceding file proves the scalar/unit-production kernel. This file +records the next unconditional module step, with right-sided order visible: +the free module `Fin n → S` is regarded as a left module over `Sᵐᵒᵖ`, so +scalar multiplication by `op a` is right multiplication by `a` in `S`. + +No claim is made here that a particular escape family produces the pure +coordinate vectors. That is the remaining Stafford correction construction. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.EscapeSpan + +open AlgebraicAnalysis.Escape + +noncomputable section + +variable {S : Type*} [Ring S] {n : ℕ} + +/-- Coordinatewise right multiplication in the free right `S`-module. -/ +def rightMulVector (v : Fin n → S) (a : S) : Fin n → S := + fun i => v i * a + +@[simp] +theorem rightMulVector_apply (v : Fin n → S) (a : S) (i : Fin n) : + rightMulVector v a i = v i * a := rfl + +@[simp] +theorem op_smul_vector (v : Fin n → S) (a : S) : + (MulOpposite.op a : Sᵐᵒᵖ) • v = rightMulVector v a := by + rfl + +/-- Coordinatewise commutator with the distinguished escape coordinate. -/ +def commutatorVector (x : S) (v : Fin n → S) : Fin n → S := + fun i => commutator x (v i) + +@[simp] +theorem commutatorVector_apply (x : S) (v : Fin n → S) (i : Fin n) : + commutatorVector x v i = commutator x (v i) := rfl + +@[simp] +theorem commutatorVector_iterate_apply (x : S) (v : Fin n → S) + (k : ℕ) (i : Fin n) : + (commutatorVector x)^[k] v i = + (commutator x)^[k] (v i) := by + induction k with + | zero => rfl + | succ k ih => + calc + ((commutatorVector x)^[k.succ] v) i = + commutatorVector x ((commutatorVector x)^[k] v) i := by + rw [Function.iterate_succ_apply'] + _ = commutator x (((commutatorVector x)^[k] v) i) := rfl + _ = commutator x ((commutator x)^[k] (v i)) := + congrArg (commutator x) (ih) + _ = ((commutator x)^[k.succ]) (v i) := by + rw [Function.iterate_succ_apply'] + +/-/ The left action needed to close a right submodule under `adₓ`. -/ +theorem commutatorVector_mem + (H : Submodule Sᵐᵒᵖ (Fin n → S)) (x : S) + (hleft : ∀ v : Fin n → S, v ∈ H → (fun i => x * v i) ∈ H) + {v : Fin n → S} (hv : v ∈ H) : + commutatorVector x v ∈ H := by + have hright : rightMulVector v x ∈ H := by + simpa only [op_smul_vector] using + H.smul_mem (MulOpposite.op x) hv + have hleft' : (fun i => x * v i) ∈ H := hleft v hv + change (fun i => v i * x - x * v i) ∈ H + change rightMulVector v x - (fun i => x * v i) ∈ H + exact H.sub_mem hright hleft' + +/-! +The key right-sided module consequence. A unit coordinate can be inverted +on the right, so a pure vector `single i u` gives every `single i a`. +-/ + +theorem single_mem_of_unit_single_mem + (H : Submodule Sᵐᵒᵖ (Fin n → S)) + (i : Fin n) {u : S} (hu : IsUnit u) + (hmem : (Pi.single i u : Fin n → S) ∈ H) (a : S) : + (Pi.single i a : Fin n → S) ∈ H := by + let w : S := (hu.unit⁻¹ : Sˣ) * a + have hsmul := H.smul_mem (MulOpposite.op w) hmem + have hunit : u * (hu.unit⁻¹ : Sˣ) = 1 := hu.mul_val_inv + have hcoord : u * w = a := by + dsimp [w] + rw [← mul_assoc, hunit, one_mul] + have heq : (MulOpposite.op w : Sᵐᵒᵖ) • + (Pi.single i u : Fin n → S) = Pi.single i a := by + funext j + by_cases hji : i = j + · subst j + change (Pi.single i u : Fin n → S) i * w = + (Pi.single i a : Fin n → S) i + simpa only [Pi.single_eq_same] using hcoord + · have hji' : j ≠ i := Ne.symm hji + simp [ hji'] + rw [← heq] + exact hsmul + +/-- +If a right `S`-submodule contains a pure unit vector in every coordinate, +then it is the whole free right module. The proof uses the finite standard +basis decomposition and never reverses the right-sided scalar order. +-/ +theorem top_of_unit_singletons + (H : Submodule Sᵐᵒᵖ (Fin n → S)) + (hunit : ∀ i : Fin n, ∃ u : S, IsUnit u ∧ + (Pi.single i u : Fin n → S) ∈ H) : + H = ⊤ := by + apply top_unique + intro v hv + have hsingle : ∀ i : Fin n, + (Pi.single i (v i) : Fin n → S) ∈ H := by + intro i + obtain ⟨u, hu, hmem⟩ := hunit i + exact single_mem_of_unit_single_mem H i hu hmem (v i) + have hdecomp : (∑ i : Fin n, Pi.single i (v i)) = v := by + funext j + simp + rw [← hdecomp] + exact H.sum_mem (fun i _ => hsingle i) + + +end +end AlgebraicAnalysis.EscapeSpan diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredSchreyer.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredSchreyer.lean new file mode 100644 index 0000000000..090a6ddb0d --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredSchreyer.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Group.Subgroup.Defs +public import Mathlib.Algebra.Module.LinearMap.Defs +public import Mathlib.Algebra.Module.Opposite +public import Mathlib.Tactic +public import Mathlib.Tactic.Abel + + +/-! +# Exact filtered Schreyer criterion + +This file isolates the abstract equivalence used when a right-linear +presentation is combined with a lower filtration piece. The right action is +encoded by the opposite scalar ring, while the lower piece is only an +additive subgroup. No Ore, Weyl, or characteristic-variety structure is +needed. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FilteredSchreyer + +universe u v + +variable {A : Type u} {E : Type v} + [Ring A] [AddCommGroup E] [Module Aᵐᵒᵖ E] + +/-- A right-linear presentation map sends the explicit right action on its +source to right multiplication in the target ring. -/ +theorem map_rightSMul (phi : E →ₗ[Aᵐᵒᵖ] A) (b : E) (x : A) : + phi ((MulOpposite.op x) • b) = phi b * x := by + rw [phi.map_smul, op_smul_eq_mul] + +/-- Exact filtered Schreyer criterion for one distinguished right action. + +The left side says that `C` lies in the image of `phi` modulo the lower +subgroup `L`. The right side expresses the corresponding source relation as +an element mapping into `L`, plus an explicit right multiple of `x`. The +hypotheses separate the two directions: right-coordinate stability is used +forward, and strictness under that coordinate is used backward. -/ +theorem range_add_lower_iff_preimage_add_rightMultiple + (phi : E →ₗ[Aᵐᵒᵖ] A) (L : AddSubgroup A) + (a : E) (C x : A) + (ha : phi a = 1 + C * x) + (hone : (1 : A) ∈ L) + (hLx : ∀ z : A, z ∈ L → z * x ∈ L) + (hstrict : ∀ z : A, z * x ∈ L → z ∈ L) : + (∃ b : E, ∃ l : A, l ∈ L ∧ C = phi b + l) ↔ + ∃ t b : E, phi t ∈ L ∧ + a = t + (MulOpposite.op x) • b := by + constructor + · rintro ⟨b, l, hl, rfl⟩ + let t := a - (MulOpposite.op x) • b + have hphiRight : phi ((MulOpposite.op x) • b) = phi b * x := + map_rightSMul phi b x + have hphit : phi t = 1 + l * x := by + dsimp [t] + rw [map_sub, hphiRight, ha] + noncomm_ring + have htLower : phi t ∈ L := by + rw [hphit] + exact L.add_mem hone (hLx l hl) + refine ⟨t, b, htLower, ?_⟩ + dsimp [t] + abel + · rintro ⟨t, b, htLower, rfl⟩ + have hphiRight : phi ((MulOpposite.op x) • b) = phi b * x := + map_rightSMul phi b x + rw [map_add, hphiRight] at ha + have hCx : C * x = phi t + phi b * x - 1 := by + apply (eq_sub_iff_add_eq).2 + calc + C * x + 1 = 1 + C * x := add_comm _ _ + _ = phi t + phi b * x := ha.symm + have hproduct : (C - phi b) * x = phi t - 1 := by + rw [sub_mul, hCx] + abel + have hproductLower : (C - phi b) * x ∈ L := by + rw [hproduct] + exact L.sub_mem htLower hone + have hlower : C - phi b ∈ L := hstrict _ hproductLower + exact ⟨b, C - phi b, hlower, by abel⟩ + + +end AlgebraicAnalysis.FilteredSchreyer diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredStrictness.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredStrictness.lean new file mode 100644 index 0000000000..de31680f89 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredStrictness.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.LinearAlgebra.Quotient.Basic + + +/-! +# Strict filtered endomorphisms + +A strict surjective endomorphism of a filtered module is surjective on every +subquotient of the filtration. The formulation here uses only submodules and +their quotients; it does not introduce a separate associated-graded framework. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FilteredStrictness + +variable {R M : Type*} [Ring R] [AddCommGroup M] [Module R M] + +/-- An endomorphism is strict for `F` when its image of every filtration piece +is the intersection of that piece with its global range. -/ +def IsStrict (F : ℕ → Submodule R M) (f : M →ₗ[R] M) : Prop := + ∀ n, (F n).map f = F n ⊓ LinearMap.range f + +/-- The filtration subquotient `F upper / F lower`, represented inside +`F upper`. The monotonicity assumption identifies the denominator with the +expected copy of `F lower`. -/ +abbrev GradedQuotient (F : ℕ → Submodule R M) (hF : Monotone F) + (lower upper : ℕ) (h : lower ≤ upper) : Type _ := + F upper ⧸ LinearMap.range (Submodule.inclusion (hF h)) + +/-- The endomorphism induced on a filtration subquotient. -/ +def gradedQuotientMap (F : ℕ → Submodule R M) (hF : Monotone F) + (f : M →ₗ[R] M) + (hpres : ∀ n, ∀ x ∈ F n, f x ∈ F n) + (lower upper : ℕ) (h : lower ≤ upper) : + GradedQuotient F hF lower upper h →ₗ[R] + GradedQuotient F hF lower upper h := by + let fUpper : F upper →ₗ[R] F upper := + LinearMap.codRestrict (F upper) (f.domRestrict (F upper)) + (fun x ↦ hpres upper x x.property) + let lowerInUpper : Submodule R (F upper) := + LinearMap.range (Submodule.inclusion (hF h)) + exact lowerInUpper.mapQ lowerInUpper fUpper (by + intro x hx + obtain ⟨y, rfl⟩ := hx + exact ⟨⟨f y, hpres lower y y.property⟩, rfl⟩) + +/-- A globally surjective filtration-preserving strict endomorphism induces a +surjection on every filtration subquotient, hence on each graded piece. -/ +theorem gradedQuotientMap_surjective + (F : ℕ → Submodule R M) (hF : Monotone F) + (f : M →ₗ[R] M) + (hpres : ∀ n, ∀ x ∈ F n, f x ∈ F n) + (hstrict : IsStrict F f) + (hsurj : Function.Surjective f) + (lower upper : ℕ) (h : lower ≤ upper) : + Function.Surjective (gradedQuotientMap F hF f hpres lower upper h) := by + have hmap : ∀ n, (F n).map f = F n := by + intro n + calc + (F n).map f = F n ⊓ LinearMap.range f := hstrict n + _ = F n := by rw [LinearMap.range_eq_top.mpr hsurj]; simp + have hUpper : Function.Surjective + (LinearMap.codRestrict (F upper) (f.domRestrict (F upper)) + (fun x ↦ hpres upper x x.property)) := by + intro y + have hy : (y : M) ∈ (F upper).map f := by + rw [hmap upper] + exact y.property + obtain ⟨x, hx, hxy⟩ := Submodule.mem_map.mp hy + exact ⟨⟨x, hx⟩, Subtype.ext hxy⟩ + intro y + obtain ⟨y, rfl⟩ := Submodule.Quotient.mk_surjective _ y + obtain ⟨x, hx⟩ := hUpper y + refine ⟨Submodule.Quotient.mk x, ?_⟩ + rw [gradedQuotientMap, Submodule.mapQ_apply, hx] + + +end AlgebraicAnalysis.FilteredStrictness diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermBoundaryExhaustion.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermBoundaryExhaustion.lean new file mode 100644 index 0000000000..ab4d599364 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermBoundaryExhaustion.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermTotalPages +public import Mathlib.Algebra.DirectSum.Module + + +/-! +# Boundary exhaustion on the total target pages + +The concrete boundary inclusions give maps from the first target page to every +later target page. Surjectivity of the underlying differential and exhaustive +filtration imply pointwise eventual vanishing; finite support then gives the +same statement on the external direct sum. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FilteredTwoTermPages + +universe u v + +variable {k : Type u} [Ring k] +variable {M : Type v} [AddCommGroup M] [Module k M] + +namespace FilteredTwoTerm + +variable (K : FilteredTwoTerm k M) + +private theorem boundaries_one_le (r : ℕ) (p : ℤ) : + K.boundaries 1 p ≤ K.boundaries (r + 1) p := by + induction r with + | zero => exact le_rfl + | succ r ihr => + exact ihr.trans (K.boundaries_le_succ (r + 1) p) + +private theorem boundaries_mono {a b : ℕ} (hab : a ≤ b) (p : ℤ) : + K.boundaries a p ≤ K.boundaries b p := by + induction b, hab using Nat.le_induction with + | base => exact le_rfl + | succ b hb ih => exact ih.trans (K.boundaries_le_succ b p) + +/-- The quotient map induced by `B₁ ⊆ B_{r+1}` at one target component. -/ +def targetBoundaryMap (r : ℕ) (p : ℤ) : + K.TargetPage 1 p →ₗ[k] K.TargetPage (r + 1) p := + Submodule.mapQ _ _ LinearMap.id (by + intro x hx + exact K.boundaries_one_le r p hx) + +@[simp] +theorem targetBoundaryMap_mk (r : ℕ) (p : ℤ) (x : K.G p) : + K.targetBoundaryMap r p (Submodule.Quotient.mk x) = + Submodule.Quotient.mk x := + Submodule.mapQ_apply _ _ _ _ + +theorem targetBoundaryMap_surjective (r : ℕ) (p : ℤ) : + Function.Surjective (K.targetBoundaryMap r p) := by + intro y + obtain ⟨x, rfl⟩ := Submodule.Quotient.mk_surjective + ((K.boundaries (r + 1) p).comap (K.G p).subtype) y + exact ⟨Submodule.Quotient.mk x, K.targetBoundaryMap_mk r p x⟩ + +/-- The component kernels grow with the page index. -/ +theorem targetBoundaryMap_ker_mono (r s : ℕ) (hrs : r ≤ s) (p : ℤ) : + LinearMap.ker (K.targetBoundaryMap r p) ≤ + LinearMap.ker (K.targetBoundaryMap s p) := by + intro y hy + obtain ⟨x, rfl⟩ := Submodule.Quotient.mk_surjective + ((K.boundaries 1 p).comap (K.G p).subtype) y + change K.targetBoundaryMap r p (Submodule.Quotient.mk x) = 0 at hy + change K.targetBoundaryMap s p (Submodule.Quotient.mk x) = 0 + rw [K.targetBoundaryMap_mk, Submodule.Quotient.mk_eq_zero] at hy ⊢ + have hpage : r + 1 ≤ s + 1 := by omega + exact K.boundaries_mono hpage p hy + +/-- The total target map into page `r+1`. -/ +def totalBoundaryMap (r : ℕ) : + K.TargetTotal 1 →ₗ[k] K.TargetTotal (r + 1) := + DirectSum.lmap (K.targetBoundaryMap r) + +@[simp] +theorem totalBoundaryMap_lof (r : ℕ) (p : ℤ) + (x : K.TargetPage 1 p) : + K.totalBoundaryMap r + (DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage 1 q) p x) = + DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage (r + 1) q) p + (K.targetBoundaryMap r p x) := by + rw [totalBoundaryMap] + exact DirectSum.lmap_of _ _ _ + +theorem totalBoundaryMap_surjective (r : ℕ) : + Function.Surjective (K.totalBoundaryMap r) := by + apply (DirectSum.lmap_surjective _).mpr + exact K.targetBoundaryMap_surjective r + +theorem totalBoundaryMap_ker_mono (r s : ℕ) (hrs : r ≤ s) : + LinearMap.ker (K.totalBoundaryMap r) ≤ + LinearMap.ker (K.totalBoundaryMap s) := by + intro x hx + apply LinearMap.mem_ker.mpr + apply DirectSum.ext_component k + intro p + have hlocal : K.targetBoundaryMap r p (x p) = 0 := by + apply LinearMap.mem_ker.mp + exact congrArg (fun z => z p) hx + have hker := K.targetBoundaryMap_ker_mono r s hrs p + exact LinearMap.mem_ker.mp (hker (LinearMap.mem_ker.mpr hlocal)) + +private theorem pointwise_boundary_exhaustion + (hG : ∀ z : M, ∃ s : ℤ, z ∈ K.G s) + (hf : Function.Surjective K.f) (p : ℤ) (y : K.TargetPage 1 p) : + ∃ r : ℕ, K.targetBoundaryMap r p y = 0 := by + obtain ⟨x, rfl⟩ := Submodule.Quotient.mk_surjective + ((K.boundaries 1 p).comap (K.G p).subtype) y + obtain ⟨n, hn⟩ := K.exists_mem_boundaries_of_surjective hG hf x.property + let r := n - 1 + have hnr : n ≤ r + 1 := by dsimp [r]; omega + have hbound : K.boundaries n p ≤ K.boundaries (r + 1) p := by + rcases n with _ | n + · exact (K.boundaries_le_succ 0 p).trans (K.boundaries_one_le r p) + · simp [r] + refine ⟨r, ?_⟩ + rw [K.targetBoundaryMap_mk, Submodule.Quotient.mk_eq_zero] + exact hbound hn + +/-- Every finitely supported total target vector is killed at some page. -/ +theorem totalBoundaryMap_eventually_zero + (hG : ∀ z : M, ∃ s : ℤ, z ∈ K.G s) + (hf : Function.Surjective K.f) (x : K.TargetTotal 1) : + ∃ r : ℕ, K.totalBoundaryMap r x = 0 := by + classical + induction x using DirectSum.induction_on with + | zero => exact ⟨0, by simp⟩ + | of p y => + obtain ⟨r, hr⟩ := K.pointwise_boundary_exhaustion hG hf p y + refine ⟨r, ?_⟩ + rw [show DirectSum.of _ p y = + DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage 1 q) p y from rfl, + K.totalBoundaryMap_lof, hr] + simp + | add x y hx hy => + obtain ⟨r, hr⟩ := hx + obtain ⟨s, hs⟩ := hy + let t := max r s + refine ⟨t, ?_⟩ + have hrt : r ≤ t := le_max_left _ _ + have hst : s ≤ t := le_max_right _ _ + have hxr := K.totalBoundaryMap_ker_mono r t hrt (LinearMap.mem_ker.mpr hr) + have hys := K.totalBoundaryMap_ker_mono s t hst (LinearMap.mem_ker.mpr hs) + rw [map_add] + rw [LinearMap.mem_ker.mp hxr, LinearMap.mem_ker.mp hys, add_zero] + + +end FilteredTwoTerm + +end AlgebraicAnalysis.FilteredTwoTermPages diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermBoundaryNaturality.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermBoundaryNaturality.lean new file mode 100644 index 0000000000..3fd6643e6a --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermBoundaryNaturality.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermTotalActions +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermBoundaryExhaustion + + +/-! +# Naturality of the target boundary maps + +The quotient maps from page one to later target pages commute with every +filtered operator. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FilteredTwoTermPages + +universe u v + +variable {k : Type u} [Ring k] +variable {M : Type v} [AddCommGroup M] [Module k M] + +namespace FilteredTwoTerm + +variable (K : FilteredTwoTerm k M) + +namespace PageOperator + +variable {K} {d : ℤ} (P : K.PageOperator d) + +theorem targetBoundaryMap_naturality (r : ℕ) (p : ℤ) : + K.targetBoundaryMap r (p - d) ∘ₗ P.targetMap 1 p = + P.targetMap (r + 1) p ∘ₗ K.targetBoundaryMap r p := by + apply LinearMap.ext + intro y + refine Submodule.Quotient.induction_on + ((K.boundaries 1 p).comap (K.G p).subtype) y ?_ + intro x + simp only [LinearMap.comp_apply, P.targetMap_mk, K.targetBoundaryMap_mk] + +theorem totalBoundaryMap_naturality (r : ℕ) : + K.totalBoundaryMap r ∘ₗ P.targetTotalMap 1 = + P.targetTotalMap (r + 1) ∘ₗ K.totalBoundaryMap r := by + apply LinearMap.ext + intro x + induction x using DirectSum.induction_on with + | zero => simp + | of p y => + rw [show DirectSum.of (fun q : ℤ => K.TargetPage 1 q) p y = + DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage 1 q) p y from rfl] + change K.totalBoundaryMap r (P.targetTotalMap 1 + (DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage 1 q) p y)) = + P.targetTotalMap (r + 1) (K.totalBoundaryMap r + (DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage 1 q) p y)) + rw [P.targetTotalMap_lof, K.totalBoundaryMap_lof, + K.totalBoundaryMap_lof, P.targetTotalMap_lof] + exact congrArg (fun z => + DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage (r + 1) q) (p - d) z) + (LinearMap.congr_fun (P.targetBoundaryMap_naturality r p) y) + | add x y hx hy => simpa using congrArg₂ (· + ·) hx hy + + +end PageOperator + +end FilteredTwoTerm + +end AlgebraicAnalysis.FilteredTwoTermPages diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermPageActions.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermPageActions.lean new file mode 100644 index 0000000000..9f679332bf --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermPageActions.lean @@ -0,0 +1,328 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPages +public import Mathlib.LinearAlgebra.Isomorphisms + + +/-! +# Filtered operators on two-term pages + +A filtered operator of degree `d` shifts `G p` into `G (p - d)` and commutes +with the two-term differential. This file constructs its maps on the concrete +source and target pages, proves compatibility with `drop`, and proves that an +operator is unchanged on pages after adding one that shifts an additional +filtration level. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FilteredTwoTermPages + +universe u v + +variable {k : Type u} [Ring k] +variable {M : Type v} [AddCommGroup M] [Module k M] + +namespace FilteredTwoTerm + +variable (K : FilteredTwoTerm k M) + +/-- A `k`-linear operator of filtration degree `d` commuting with the +two-term differential. -/ +structure PageOperator (d : ℤ) where + /-- The underlying endomorphism of the filtered module. -/ + g : M →ₗ[k] M + commute : K.f.comp g = g.comp K.f + shift : ∀ p x, x ∈ K.G p → g x ∈ K.G (p - d) + +namespace PageOperator + +variable {K} {d : ℤ} (P : K.PageOperator d) + +/-- Composition of filtered operators. -/ +def comp {e : ℤ} (Q : K.PageOperator e) : K.PageOperator (d + e) where + g := P.g.comp Q.g + commute := by + apply LinearMap.ext + intro x + change K.f (P.g (Q.g x)) = P.g (Q.g (K.f x)) + have hp := LinearMap.congr_fun P.commute (Q.g x) + have hq := LinearMap.congr_fun Q.commute x + change K.f (P.g (Q.g x)) = P.g (K.f (Q.g x)) at hp + change K.f (Q.g x) = Q.g (K.f x) at hq + rw [hp, hq] + shift := by + intro p x hx + have hQ := Q.shift p x hx + have hP := P.shift (p - e) (Q.g x) hQ + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hP + +/-- The reverse-order composition, given the same canonical sum degree. -/ +def reverseComp {e : ℤ} (Q : K.PageOperator e) : K.PageOperator (d + e) where + g := Q.g.comp P.g + commute := by + apply LinearMap.ext + intro x + change K.f (Q.g (P.g x)) = Q.g (P.g (K.f x)) + have hq := LinearMap.congr_fun Q.commute (P.g x) + have hp := LinearMap.congr_fun P.commute x + change K.f (Q.g (P.g x)) = Q.g (K.f (P.g x)) at hq + change K.f (P.g x) = P.g (K.f x) at hp + rw [hq, hp] + shift := by + intro p x hx + have hP := P.shift p x hx + have hQ := Q.shift (p - d) (P.g x) hP + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hQ + +private theorem coe_castG {p q : ℤ} (h : p = q) (x : K.G p) : + ((h ▸ x : K.G q) : M) = (x : M) := by + subst q + rfl + +theorem commute_apply (x : M) : K.f (P.g x) = P.g (K.f x) := by + exact LinearMap.congr_fun P.commute x + +/-- The restriction of the operator to a source-page cycle numerator. -/ +def sourceRestricted (r : ℕ) (p : ℤ) : + K.cycles r p →ₗ[k] K.cycles r (p - d) := + (P.g.comp (K.cycles r p).subtype).codRestrict (K.cycles r (p - d)) (by + intro x + refine ⟨P.shift p (x : M) x.property.1, ?_⟩ + change K.f (P.g (x : M)) ∈ K.G (p - d + r) + rw [P.commute_apply] + have h := P.shift (p + r) (K.f (x : M)) x.property.2 + have hindex : p + (r : ℤ) - d = p - d + (r : ℤ) := by omega + rwa [hindex] at h) + +private theorem sourceRestricted_denominator (r : ℕ) (p : ℤ) : + (K.G (p + 1)).comap (K.cycles r p).subtype ≤ + ((K.G (p - d + 1)).comap (K.cycles r (p - d)).subtype).comap + (P.sourceRestricted r p) := by + intro x hx + change P.g (x : M) ∈ K.G (p - d + 1) + have h := P.shift (p + 1) (x : M) hx + have hindex : p + 1 - d = p - d + 1 := by omega + rwa [hindex] at h + +/-- The operator induced on a source page. -/ +def sourceMap (r : ℕ) (p : ℤ) : + K.SourcePage r p →ₗ[k] K.SourcePage r (p - d) := + Submodule.mapQ _ _ (P.sourceRestricted r p) + (by exact P.sourceRestricted_denominator r p) + +@[simp] +theorem sourceMap_mk (r : ℕ) (p : ℤ) (x : K.cycles r p) : + P.sourceMap r p (Submodule.Quotient.mk x) = + Submodule.Quotient.mk (P.sourceRestricted r p x) := + Submodule.mapQ_apply _ _ _ _ + +/-- Transport between equal source-page indices. -/ +def sourcePageCast (r : ℕ) {p q : ℤ} (h : p = q) : + K.SourcePage r p ≃ₗ[k] K.SourcePage r q := by + subst q + exact LinearEquiv.refl k _ + +@[simp] +theorem sourcePageCast_mk (r : ℕ) {p q : ℤ} (h : p = q) + (x : K.cycles r p) : + sourcePageCast (K := K) r h (Submodule.Quotient.mk x) = + Submodule.Quotient.mk (h ▸ x) := by + subst q + rfl + +/-- The restriction of the operator to a target-page filtration piece. -/ +def targetRestricted (p : ℤ) : K.G p →ₗ[k] K.G (p - d) := + (P.g.comp (K.G p).subtype).codRestrict (K.G (p - d)) + (fun x => P.shift p (x : M) x.property) + +private theorem maps_boundaries (r : ℕ) (p : ℤ) {x : M} + (hx : x ∈ K.boundaries r p) : P.g x ∈ K.boundaries r (p - d) := by + rcases Submodule.mem_sup.mp hx with ⟨a, ha, e, he, rfl⟩ + rw [map_add] + apply Submodule.add_mem + · apply Submodule.mem_sup.mpr + refine ⟨P.g a, ⟨P.shift p a ha.1, ?_⟩, 0, Submodule.zero_mem _, by simp⟩ + rcases ha.2 with ⟨z, hz, rfl⟩ + refine ⟨P.g z, ?_, ?_⟩ + · have h := P.shift (p - r + 1) z hz + have hindex : p - (r : ℤ) + 1 - d = p - d - (r : ℤ) + 1 := by omega + rwa [hindex] at h + · exact P.commute_apply z + · apply Submodule.mem_sup.mpr + have h := P.shift (p + 1) e he + have hindex : p + 1 - d = p - d + 1 := by omega + rw [hindex] at h + exact ⟨0, Submodule.zero_mem _, P.g e, h, by simp⟩ + +private theorem targetRestricted_denominator (r : ℕ) (p : ℤ) : + (K.boundaries r p).comap (K.G p).subtype ≤ + ((K.boundaries r (p - d)).comap (K.G (p - d)).subtype).comap + (P.targetRestricted p) := by + intro x hx + exact P.maps_boundaries r p hx + +/-- The operator induced on a target page. -/ +def targetMap (r : ℕ) (p : ℤ) : + K.TargetPage r p →ₗ[k] K.TargetPage r (p - d) := + Submodule.mapQ _ _ (P.targetRestricted p) + (by exact P.targetRestricted_denominator r p) + +@[simp] +theorem targetMap_mk (r : ℕ) (p : ℤ) (x : K.G p) : + P.targetMap r p (Submodule.Quotient.mk x) = + Submodule.Quotient.mk (P.targetRestricted p x) := + Submodule.mapQ_apply _ _ _ _ + +/-- Transport between target-page indices known to be equal. -/ +def targetPageCast (r : ℕ) {p q : ℤ} (h : p = q) : + K.TargetPage r p ≃ₗ[k] K.TargetPage r q := by + subst q + exact LinearEquiv.refl k _ + +@[simp] +theorem targetPageCast_mk (r : ℕ) {p q : ℤ} (h : p = q) + (x : K.G p) : + targetPageCast (K := K) r h (Submodule.Quotient.mk x) = + Submodule.Quotient.mk (h ▸ x) := by + subst q + rfl + +/-- Restrict the operator to the target filtration at a page differential. -/ +def targetRestrictedAtDrop (r : ℕ) (p : ℤ) : + K.G (p + r) →ₗ[k] K.G (p - d + r) := + (P.g.comp (K.G (p + r)).subtype).codRestrict (K.G (p - d + r)) (by + intro x + have h := P.shift (p + r) (x : M) x.property + have hindex : p + (r : ℤ) - d = p - d + (r : ℤ) := by omega + rwa [hindex] at h) + +private theorem targetRestrictedAtDrop_denominator (r : ℕ) (p : ℤ) : + (K.boundaries r (p + r)).comap (K.G (p + r)).subtype ≤ + ((K.boundaries r (p - d + r)).comap (K.G (p - d + r)).subtype).comap + (P.targetRestrictedAtDrop r p) := by + intro x hx + have h := P.maps_boundaries r (p + r) hx + have hindex : p + (r : ℤ) - d = p - d + (r : ℤ) := by omega + rwa [hindex] at h + +/-- The target-page operator at the codomain index of `drop`, reindexed by +the identity `(p+r)-d = (p-d)+r`. -/ +def targetMapAtDrop (r : ℕ) (p : ℤ) : + K.TargetPage r (p + r) →ₗ[k] K.TargetPage r (p - d + r) := + Submodule.mapQ _ _ (P.targetRestrictedAtDrop r p) + (by exact P.targetRestrictedAtDrop_denominator r p) + +@[simp] +theorem targetMapAtDrop_mk (r : ℕ) (p : ℤ) (x : K.G (p + r)) : + P.targetMapAtDrop r p (Submodule.Quotient.mk x) = + Submodule.Quotient.mk (P.targetRestrictedAtDrop r p x) := + Submodule.mapQ_apply _ _ _ _ + +/-- `targetMapAtDrop` is the general target-page map followed by the canonical +reindexing isomorphism. -/ +theorem targetMapAtDrop_eq_cast_targetMap (r : ℕ) (p : ℤ) : + P.targetMapAtDrop r p = + (targetPageCast (K := K) r + (by omega : p + (r : ℤ) - d = p - d + (r : ℤ))).toLinearMap.comp + (P.targetMap r (p + r)) := by + let hindex : p + (r : ℤ) - d = p - d + (r : ℤ) := by omega + change P.targetMapAtDrop r p = + (targetPageCast (K := K) r hindex).toLinearMap.comp + (P.targetMap r (p + r)) + apply LinearMap.ext + intro y + refine Submodule.Quotient.induction_on + ((K.boundaries r (p + r)).comap (K.G (p + r)).subtype) y ?_ + intro x + rw [P.targetMapAtDrop_mk, LinearMap.comp_apply, P.targetMap_mk] + change Submodule.Quotient.mk (P.targetRestrictedAtDrop r p x) = + targetPageCast (K := K) r _ + (Submodule.Quotient.mk (P.targetRestricted (p + r) x)) + rw [targetPageCast_mk] + congr 1 + apply Subtype.ext + change P.g (x : M) = + ((hindex ▸ P.targetRestricted (p + r) x : K.G (p - d + r)) : M) + rw [coe_castG] + rfl + +/-- The source and reindexed target operator maps commute with the page +differential. -/ +theorem targetMapAtDrop_drop (r : ℕ) (p : ℤ) (x : K.SourcePage r p) : + P.targetMapAtDrop r p (K.drop r p x) = + K.drop r (p - d) (P.sourceMap r p x) := by + refine Submodule.Quotient.induction_on + ((K.G (p + 1)).comap (K.cycles r p).subtype) x ?_ + intro z + rw [K.drop_mk, P.targetMapAtDrop_mk, P.sourceMap_mk, K.drop_mk] + change Submodule.Quotient.mk (⟨P.g (K.f (z : M)), _⟩ : K.G (p - d + r)) = + Submodule.Quotient.mk (⟨K.f (P.g (z : M)), _⟩ : K.G (p - d + r)) + congr 2 + exact (P.commute_apply (z : M)).symm + +/-- Compatibility of the general source and target page maps with `drop`, +with the unavoidable target-index transport made explicit. -/ +theorem targetMap_drop (r : ℕ) (p : ℤ) (x : K.SourcePage r p) : + targetPageCast (K := K) r + (by omega : p + (r : ℤ) - d = p - d + (r : ℤ)) + (P.targetMap r (p + r) (K.drop r p x)) = + K.drop r (p - d) (P.sourceMap r p x) := by + let hindex : p + (r : ℤ) - d = p - d + (r : ℤ) := by omega + change ((targetPageCast (K := K) r hindex).toLinearMap.comp + (P.targetMap r (p + r))) (K.drop r p x) = _ + rw [← P.targetMapAtDrop_eq_cast_targetMap r p] + exact P.targetMapAtDrop_drop r p x + +/-- Two degree-`d` operators have the same symbol when their difference shifts +one additional filtration level. -/ +def SameSymbol (Q : K.PageOperator d) : Prop := + ∀ p x, x ∈ K.G p → (P.g - Q.g) x ∈ K.G (p - d + 1) + +theorem sourceMap_eq_of_sameSymbol {Q : K.PageOperator d} + (hPQ : P.SameSymbol Q) (r : ℕ) (p : ℤ) : + P.sourceMap r p = Q.sourceMap r p := by + apply LinearMap.ext + intro y + refine Submodule.Quotient.induction_on + ((K.G (p + 1)).comap (K.cycles r p).subtype) y ?_ + intro x + rw [P.sourceMap_mk, Q.sourceMap_mk] + apply (Submodule.Quotient.eq _).2 + change P.g (x : M) - Q.g (x : M) ∈ K.G (p - d + 1) + simpa using hPQ p (x : M) x.property.1 + +theorem targetMap_eq_of_sameSymbol {Q : K.PageOperator d} + (hPQ : P.SameSymbol Q) (r : ℕ) (p : ℤ) : + P.targetMap r p = Q.targetMap r p := by + apply LinearMap.ext + intro y + refine Submodule.Quotient.induction_on + ((K.boundaries r p).comap (K.G p).subtype) y ?_ + intro x + rw [P.targetMap_mk, Q.targetMap_mk] + apply (Submodule.Quotient.eq _).2 + change P.g (x : M) - Q.g (x : M) ∈ K.boundaries r (p - d) + exact Submodule.mem_sup.mpr + ⟨0, Submodule.zero_mem _, P.g (x : M) - Q.g (x : M), + hPQ p (x : M) x.property, by simp⟩ + +theorem targetMapAtDrop_eq_of_sameSymbol {Q : K.PageOperator d} + (hPQ : P.SameSymbol Q) (r : ℕ) (p : ℤ) : + P.targetMapAtDrop r p = Q.targetMapAtDrop r p := by + rw [P.targetMapAtDrop_eq_cast_targetMap, + Q.targetMapAtDrop_eq_cast_targetMap, + P.targetMap_eq_of_sameSymbol hPQ r (p + r)] + + +end PageOperator + +end FilteredTwoTerm + +end AlgebraicAnalysis.FilteredTwoTermPages diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermPageEquivalences.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermPageEquivalences.lean new file mode 100644 index 0000000000..26f2f4a37e --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermPageEquivalences.lean @@ -0,0 +1,236 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPages +public import Mathlib.LinearAlgebra.Isomorphisms + + +/-! +# Successor equivalences for the filtered two-term pages + +This file proves, from the concrete representative definitions in +`FilteredTwoTermPages`, that the next source page is the kernel of the page +differential and that the next target page is its cokernel. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FilteredTwoTermPages + +universe u v + +variable {k : Type u} [Ring k] +variable {M : Type v} [AddCommGroup M] [Module k M] + +namespace FilteredTwoTerm + +variable (K : FilteredTwoTerm k M) + +private abbrev sourceDenominator (r : ℕ) (p : ℤ) : + Submodule k (K.cycles r p) := + (K.G (p + 1)).comap (K.cycles r p).subtype + +private abbrev targetDenominator (r : ℕ) (p : ℤ) : + Submodule k (K.G p) := + (K.boundaries r p).comap (K.G p).subtype + +/-- Include cycles surviving the next page into the current cycle numerator. -/ +def sourceSuccInclusion (r : ℕ) (p : ℤ) : + K.cycles (r + 1) p →ₗ[k] K.cycles r p := + Submodule.inclusion (K.cycles_succ_le r p) + +private theorem sourceSuccInclusion_denominator (r : ℕ) (p : ℤ) : + K.sourceDenominator (r + 1) p ≤ + (K.sourceDenominator r p).comap (K.sourceSuccInclusion r p) := by + intro x hx + exact hx + +/-- The map from the next source page to the current source page. -/ +def sourceSuccMap (r : ℕ) (p : ℤ) : + K.SourcePage (r + 1) p →ₗ[k] K.SourcePage r p := + Submodule.mapQ _ _ (K.sourceSuccInclusion r p) + (by exact K.sourceSuccInclusion_denominator r p) + +@[simp] +theorem sourceSuccMap_mk (r : ℕ) (p : ℤ) + (x : K.cycles (r + 1) p) : + K.sourceSuccMap r p (Submodule.Quotient.mk x) = + Submodule.Quotient.mk (K.sourceSuccInclusion r p x) := + Submodule.mapQ_apply _ _ _ _ + +private theorem drop_sourceSuccMap_eq_zero (r : ℕ) (p : ℤ) + (x : K.SourcePage (r + 1) p) : + K.drop r p (K.sourceSuccMap r p x) = 0 := by + refine Submodule.Quotient.induction_on (K.sourceDenominator (r + 1) p) x ?_ + intro z + rw [K.sourceSuccMap_mk] + exact K.drop_mk_eq_zero_of_mem_cycles_succ r p + (K.sourceSuccInclusion r p z) z.property + +/-- The canonical map from the next source page into the kernel of `d_r`. -/ +def sourceSuccKernelMap (r : ℕ) (p : ℤ) : + K.SourcePage (r + 1) p →ₗ[k] LinearMap.ker (K.drop r p) := + (K.sourceSuccMap r p).codRestrict (LinearMap.ker (K.drop r p)) + (by exact K.drop_sourceSuccMap_eq_zero r p) + +private theorem sourceSuccMap_injective (r : ℕ) (p : ℤ) : + Function.Injective (K.sourceSuccMap r p) := by + intro a b + revert b + refine Submodule.Quotient.induction_on (K.sourceDenominator (r + 1) p) a ?_ + intro x b + refine Submodule.Quotient.induction_on (K.sourceDenominator (r + 1) p) b ?_ + intro y hab + rw [K.sourceSuccMap_mk, K.sourceSuccMap_mk] at hab + apply (Submodule.Quotient.eq (K.sourceDenominator (r + 1) p)).2 + have hmem := + (Submodule.Quotient.eq (K.sourceDenominator r p)).1 hab + exact hmem + +private theorem sourceSuccKernelMap_surjective (r : ℕ) (p : ℤ) : + Function.Surjective (K.sourceSuccKernelMap r p) := by + rintro ⟨y, hy⟩ + obtain ⟨x, rfl⟩ := Submodule.Quotient.mk_surjective + (K.sourceDenominator r p) y + have hxzero : K.drop r p (Submodule.Quotient.mk x) = 0 := hy + obtain ⟨z, hz, hxz⟩ := + K.exists_cycles_succ_rep_of_drop_mk_eq_zero r p x hxzero + let w : K.cycles (r + 1) p := ⟨(x : M) - z, hxz⟩ + refine ⟨Submodule.Quotient.mk w, Subtype.ext ?_⟩ + rw [show ((K.sourceSuccKernelMap r p + (Submodule.Quotient.mk w) : LinearMap.ker (K.drop r p)) : + K.SourcePage r p) = K.sourceSuccMap r p (Submodule.Quotient.mk w) from rfl] + rw [K.sourceSuccMap_mk] + apply (Submodule.Quotient.eq (K.sourceDenominator r p)).2 + change ((w : M) - (x : M)) ∈ K.G (p + 1) + simpa [w] using (K.G (p + 1)).neg_mem hz + +/-- On the source, the next page is the kernel of the current page +differential. -/ +noncomputable def sourceSuccEquivKerDrop (r : ℕ) (p : ℤ) : + K.SourcePage (r + 1) p ≃ₗ[k] LinearMap.ker (K.drop r p) := + LinearEquiv.ofBijective (K.sourceSuccKernelMap r p) + (by + exact ⟨fun _ _ h => K.sourceSuccMap_injective r p (congrArg Subtype.val h), + K.sourceSuccKernelMap_surjective r p⟩) + +/-- The quotient map from a target page to its successor page. -/ +def targetSuccMap (r : ℕ) (p : ℤ) : + K.TargetPage r p →ₗ[k] K.TargetPage (r + 1) p := + Submodule.mapQ _ _ LinearMap.id (by + intro x hx + exact K.boundaries_le_succ r p hx) + +@[simp] +private theorem targetSuccMap_mk (r : ℕ) (p : ℤ) + (x : K.G p) : + K.targetSuccMap r p (Submodule.Quotient.mk x) = + Submodule.Quotient.mk x := + Submodule.mapQ_apply _ _ _ _ + +theorem targetSuccMap_surjective (r : ℕ) (p : ℤ) : + Function.Surjective (K.targetSuccMap r p) := by + intro y + obtain ⟨x, rfl⟩ := Submodule.Quotient.mk_surjective + (K.targetDenominator (r + 1) p) y + exact ⟨Submodule.Quotient.mk x, K.targetSuccMap_mk r p x⟩ + +private theorem targetSuccMap_drop_eq_zero (r : ℕ) (p : ℤ) + (x : K.SourcePage r p) : + K.targetSuccMap r (p + r) (K.drop r p x) = 0 := by + refine Submodule.Quotient.induction_on (K.sourceDenominator r p) x ?_ + intro z + rw [K.drop_mk, K.targetSuccMap_mk, Submodule.Quotient.mk_eq_zero] + change K.f (z : M) ∈ K.boundaries (r + 1) (p + r) + apply Submodule.mem_sup.mpr + refine ⟨K.f (z : M), ⟨z.property.2, ?_⟩, + 0, Submodule.zero_mem _, by simp⟩ + refine ⟨(z : M), ?_, rfl⟩ + have hind : p + (r : ℤ) - ((r + 1 : ℕ) : ℤ) + 1 = p := by + push_cast + omega + rw [hind] + exact z.property.1 + +private theorem range_drop_le_ker_targetSuccMap (r : ℕ) (p : ℤ) : + LinearMap.range (K.drop r p) ≤ + LinearMap.ker (K.targetSuccMap r (p + r)) := by + rintro _ ⟨x, rfl⟩ + exact LinearMap.mem_ker.mpr (K.targetSuccMap_drop_eq_zero r p x) + +private theorem ker_targetSuccMap_le_range_drop (r : ℕ) (p : ℤ) : + LinearMap.ker (K.targetSuccMap r (p + r)) ≤ + LinearMap.range (K.drop r p) := by + intro y hy + change K.targetSuccMap r (p + r) y = 0 at hy + revert hy + refine Submodule.Quotient.induction_on (K.targetDenominator r (p + r)) y ?_ + intro y hy + rw [K.targetSuccMap_mk, Submodule.Quotient.mk_eq_zero] at hy + change (y : M) ∈ K.boundaries (r + 1) (p + r) at hy + obtain ⟨z, hz, e, he, hsum⟩ := K.mem_boundaries_succ_rep r (p + r) hy + have hindex : p + (r : ℤ) - (r : ℤ) = p := by omega + have hzp : z ∈ K.G p := by simpa [hindex] using hz + have he' : e ∈ K.G (p + r) := K.next_le (p + r) he + have hfz : K.f z ∈ K.G (p + r) := by + have : K.f z = (y : M) - e := by rw [hsum]; simp + rw [this] + exact Submodule.sub_mem _ y.property he' + let x : K.cycles r p := ⟨z, hzp, hfz⟩ + refine ⟨Submodule.Quotient.mk x, ?_⟩ + rw [K.drop_mk] + apply (Submodule.Quotient.eq (K.targetDenominator r (p + r))).2 + change K.f z - (y : M) ∈ K.boundaries r (p + r) + have hdifference : K.f z - (y : M) = -e := by + rw [hsum] + abel + rw [hdifference] + apply (K.boundaries r (p + r)).neg_mem + exact Submodule.mem_sup.mpr + ⟨0, Submodule.zero_mem _, e, he, by simp⟩ + +theorem ker_targetSuccMap_eq_range_drop (r : ℕ) (p : ℤ) : + LinearMap.ker (K.targetSuccMap r (p + r)) = + LinearMap.range (K.drop r p) := + le_antisymm (K.ker_targetSuccMap_le_range_drop r p) + (by exact K.range_drop_le_ker_targetSuccMap r p) + +/-- The map from the cokernel of `d_r` to the next target page. -/ +def targetCokernelMap (r : ℕ) (p : ℤ) : + (K.TargetPage r (p + r) ⧸ LinearMap.range (K.drop r p)) →ₗ[k] + K.TargetPage (r + 1) (p + r) := + (LinearMap.range (K.drop r p)).liftQ (K.targetSuccMap r (p + r)) + (by exact K.range_drop_le_ker_targetSuccMap r p) + +private theorem targetCokernelMap_injective (r : ℕ) (p : ℤ) : + Function.Injective (K.targetCokernelMap r p) := by + rw [← LinearMap.ker_eq_bot] + exact Submodule.ker_liftQ_eq_bot _ _ + (by exact K.range_drop_le_ker_targetSuccMap r p) + (K.ker_targetSuccMap_eq_range_drop r p).le + +private theorem targetCokernelMap_surjective (r : ℕ) (p : ℤ) : + Function.Surjective (K.targetCokernelMap r p) := by + intro y + obtain ⟨x, rfl⟩ := K.targetSuccMap_surjective r (p + r) y + exact ⟨Submodule.Quotient.mk x, Submodule.liftQ_apply _ _ _⟩ + +/-- On the target, the next page is the cokernel of the current page +differential. -/ +noncomputable def targetSuccEquivCokerDrop (r : ℕ) (p : ℤ) : + K.TargetPage (r + 1) (p + r) ≃ₗ[k] + K.TargetPage r (p + r) ⧸ LinearMap.range (K.drop r p) := + (LinearEquiv.ofBijective (K.targetCokernelMap r p) + (by + exact ⟨K.targetCokernelMap_injective r p, + K.targetCokernelMap_surjective r p⟩)).symm + + +end FilteredTwoTerm + +end AlgebraicAnalysis.FilteredTwoTermPages diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermPages.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermPages.lean new file mode 100644 index 0000000000..527682dd31 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermPages.lean @@ -0,0 +1,193 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.LinearAlgebra.Quotient.Basic +public import Mathlib.Tactic + + +/-! +# Pages of a filtered two-term complex + +This file constructs the `Z_r` and `B_r` subquotients for a two-term filtered +complex. The page differential is induced by the original differential on +representatives; no successor-page equivalence is part of the input. + +We use a decreasing, integer-indexed filtration `G`, as obtained from an +increasing filtration `F` by `G p = F (-p)`. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FilteredTwoTermPages + +universe u v + +variable {k : Type u} [Ring k] +variable {M : Type v} [AddCommGroup M] [Module k M] + +/-- A filtration-preserving two-term complex `M --f--> M`. -/ +structure FilteredTwoTerm (k : Type u) (M : Type v) [Ring k] + [AddCommGroup M] [Module k M] where + /-- The decreasing filtration on the underlying module. -/ + G : ℤ → Submodule k M + antitone : Antitone G + /-- The differential of the two-term complex. -/ + f : M →ₗ[k] M + map_le : ∀ p, (G p).map f ≤ G p + +namespace FilteredTwoTerm + +variable (K : FilteredTwoTerm k M) + +/-- The numerator of `Z_r` in the source. -/ +def cycles (r : ℕ) (p : ℤ) : Submodule k M := + K.G p ⊓ (K.G (p + r)).comap K.f + +/-- The numerator of `B_r` in the target. -/ +def boundaries (r : ℕ) (p : ℤ) : Submodule k M := + (K.G p ⊓ (K.G (p - r + 1)).map K.f) ⊔ K.G (p + 1) + +theorem next_le (p : ℤ) : K.G (p + 1) ≤ K.G p := + K.antitone (by omega) + +theorem boundaries_le (r : ℕ) (p : ℤ) : K.boundaries r p ≤ K.G p := by + apply sup_le + · exact inf_le_left + · exact K.next_le p + +/-- The actual source page. Using the intersection numerator gives the +canonical model +`(G^p ∩ f⁻¹G^{p+r}) / (G^{p+1} ∩ f⁻¹G^{p+r})`, equivalent to the displayed +`(intersection + G^{p+1})/G^{p+1}` formula. -/ +abbrev SourcePage (r : ℕ) (p : ℤ) := + K.cycles r p ⧸ (K.G (p + 1)).comap (K.cycles r p).subtype + +/-- The actual target page `G^p/B_r`. -/ +abbrev TargetPage (r : ℕ) (p : ℤ) := + K.G p ⧸ (K.boundaries r p).comap (K.G p).subtype + +-- Explicit instances also resolve these groups inside dependent direct sums. +instance sourcePageAddCommGroup (r : ℕ) (p : ℤ) : AddCommGroup (K.SourcePage r p) := + inferInstanceAs (AddCommGroup + (K.cycles r p ⧸ (K.G (p + 1)).comap (K.cycles r p).subtype)) + +instance targetPageAddCommGroup (r : ℕ) (p : ℤ) : AddCommGroup (K.TargetPage r p) := + inferInstanceAs (AddCommGroup + (K.G p ⧸ (K.boundaries r p).comap (K.G p).subtype)) + +/-- Apply the filtered differential to a cycle representative. -/ +def restrictedDrop (r : ℕ) (p : ℤ) : + K.cycles r p →ₗ[k] K.G (p + r) := + (K.f.comp (K.cycles r p).subtype).codRestrict (K.G (p + r)) + (fun x => x.property.2) + +private theorem drop_denominator (r : ℕ) (p : ℤ) : + (K.G (p + 1)).comap (K.cycles r p).subtype ≤ + ((K.boundaries r (p + r)).comap (K.G (p + r)).subtype).comap + (K.restrictedDrop r p) := by + intro x hx + change K.f (x : M) ∈ K.boundaries r (p + r) + apply Submodule.mem_sup.mpr + refine ⟨K.f (x : M), ⟨x.property.2, ?_⟩, 0, Submodule.zero_mem _, by simp⟩ + refine ⟨x, ?_, ?_⟩ + · simpa using hx + rfl + +/-- The page differential, formed by applying `f` to a representative. -/ +def drop (r : ℕ) (p : ℤ) : + K.SourcePage r p →ₗ[k] K.TargetPage r (p + r) := + Submodule.mapQ _ _ (K.restrictedDrop r p) (by exact K.drop_denominator r p) + +/-- Representative formula for the page differential. -/ +@[simp] +theorem drop_mk (r : ℕ) (p : ℤ) (x : K.cycles r p) : + K.drop r p (Submodule.Quotient.mk x) = + Submodule.Quotient.mk (K.restrictedDrop r p x) := rfl + +/-- Cycle numerators decrease from page `r` to page `r+1`. -/ +theorem cycles_succ_le (r : ℕ) (p : ℤ) : + K.cycles (r + 1) p ≤ K.cycles r p := by + intro x hx + exact ⟨hx.1, K.antitone (by push_cast; omega) hx.2⟩ + +/-- Boundary numerators increase from page `r` to page `r+1`. -/ +theorem boundaries_le_succ (r : ℕ) (p : ℤ) : + K.boundaries r p ≤ K.boundaries (r + 1) p := by + apply sup_le + · apply le_sup_of_le_left + intro x hx + refine ⟨hx.1, ?_⟩ + rcases hx.2 with ⟨z, hz, rfl⟩ + refine ⟨z, K.antitone (by push_cast; omega) hz, rfl⟩ + · exact le_sup_of_le_right le_rfl + +/-- A representative in `Z_{r+1}` is killed by the `r`-page differential. -/ +theorem drop_mk_eq_zero_of_mem_cycles_succ (r : ℕ) (p : ℤ) + (x : K.cycles r p) (hx : (x : M) ∈ K.cycles (r + 1) p) : + K.drop r p (Submodule.Quotient.mk x) = 0 := by + rw [K.drop_mk] + rw [Submodule.Quotient.mk_eq_zero] + change K.f (x : M) ∈ K.boundaries r (p + r) + have hind : p + (r + 1 : ℕ) = p + (r : ℕ) + 1 := by + push_cast + omega + exact Submodule.mem_sup.mpr + ⟨0, Submodule.zero_mem _, K.f (x : M), (hind ▸ hx.2), by simp⟩ + +/-- Conversely, a representative killed by `d_r` can be changed by an +element of `G^{p+1}` to a representative in `Z_{r+1}`. -/ +theorem exists_cycles_succ_rep_of_drop_mk_eq_zero (r : ℕ) (p : ℤ) + (x : K.cycles r p) (hx : K.drop r p (Submodule.Quotient.mk x) = 0) : + ∃ z ∈ K.G (p + 1), (x : M) - z ∈ K.cycles (r + 1) p := by + rw [K.drop_mk, Submodule.Quotient.mk_eq_zero] at hx + rcases Submodule.mem_sup.mp hx with ⟨a, ha, e, he, hsum⟩ + rcases ha.2 with ⟨z, hz, rfl⟩ + change K.f z + e = K.f (x : M) at hsum + refine ⟨z, ?_, ?_⟩ + · simpa using hz + refine ⟨Submodule.sub_mem _ x.property.1 (K.next_le p (by simpa using hz)), ?_⟩ + have hind : p + (r + 1 : ℕ) = p + (r : ℕ) + 1 := by + push_cast + omega + rw [hind] + have hfe : K.f ((x : M) - z) = e := by + rw [map_sub, ← hsum] + simp + change K.f ((x : M) - z) ∈ K.G (p + (r : ℤ) + 1) + rw [hfe] + exact he + +/-- Every new boundary representative is a drop plus a lower-filtration term. -/ +theorem mem_boundaries_succ_rep (r : ℕ) (p : ℤ) + {y : M} (hy : y ∈ K.boundaries (r + 1) p) : + ∃ z ∈ K.G (p - r), ∃ e ∈ K.G (p + 1), y = K.f z + e := by + rcases Submodule.mem_sup.mp hy with ⟨y', hy', e, he, hsum⟩ + rcases hy' with ⟨hyp, z, hz, rfl⟩ + have hind : p - ((r + 1 : ℕ) : ℤ) + 1 = p - (r : ℤ) := by + push_cast + omega + exact ⟨z, hind ▸ hz, + e, he, hsum.symm⟩ + +/-- Surjectivity exhausts the target boundary numerators. -/ +theorem exists_mem_boundaries_of_surjective + (hG : ∀ z : M, ∃ s : ℤ, z ∈ K.G s) + (hf : Function.Surjective K.f) {p : ℤ} {y : M} (hy : y ∈ K.G p) : + ∃ r : ℕ, y ∈ K.boundaries r p := by + obtain ⟨z, rfl⟩ := hf y + obtain ⟨s, hs⟩ := hG z + obtain ⟨r, hr⟩ : ∃ r : ℕ, p - r + 1 ≤ s := by + refine ⟨Int.toNat (p - s + 1), ?_⟩ + omega + refine ⟨r, Submodule.mem_sup.mpr ?_⟩ + exact ⟨K.f z, ⟨hy, ⟨z, K.antitone hr hs, rfl⟩⟩, + 0, Submodule.zero_mem _, by simp⟩ + +end FilteredTwoTerm + +end AlgebraicAnalysis.FilteredTwoTermPages diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermSuccessorNaturality.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermSuccessorNaturality.lean new file mode 100644 index 0000000000..ba3cc8cc60 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermSuccessorNaturality.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermTotalActions + + +/-! +# Naturality of the total successor maps + +The concrete successor maps on the source and target pages commute with the +page action. The proof is by direct-sum induction and quotient +representatives; no abstract successor-page interface is used. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FilteredTwoTermPages + +universe u v + +variable {k : Type u} [Ring k] +variable {M : Type v} [AddCommGroup M] [Module k M] + +namespace FilteredTwoTerm + +namespace PageOperator + +variable {K : FilteredTwoTerm k M} {d : ℤ} (P : K.PageOperator d) + +theorem sourceTotalSuccMap_naturality (r : ℕ) : + K.sourceTotalSuccMap r ∘ₗ P.sourceTotalMap (r + 1) = + P.sourceTotalMap r ∘ₗ K.sourceTotalSuccMap r := by + apply LinearMap.ext + intro x + induction x using DirectSum.induction_on with + | zero => simp + | of p x => + rw [show DirectSum.of (fun q : ℤ => K.SourcePage (r + 1) q) p x = + DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage (r + 1) q) p x from rfl] + rw [LinearMap.comp_apply, LinearMap.comp_apply] + simp only [sourceTotalSuccMap, DirectSum.lmap_lof] + rw [P.sourceTotalMap_lof] + change K.sourceTotalSuccMap r + (DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage (r + 1) q) (p - d) + (P.sourceMap (r + 1) p x)) = + P.sourceTotalMap r + (DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage r q) p + (K.sourceSuccMap r p x)) + rw [sourceTotalSuccMap, DirectSum.lmap_lof] + rw [P.sourceTotalMap_lof] + apply congrArg (fun z => + DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage r q) (p - d) z) + refine Submodule.Quotient.induction_on + ((K.G (p + 1)).comap (K.cycles (r + 1) p).subtype) x ?_ + intro z + rw [K.sourceSuccMap_mk, P.sourceMap_mk] + simp only [sourceSuccEquivKerDrop, sourceSuccKernelMap, sourceSuccMap, LinearMap.coe_comp, + Submodule.coe_subtype, LinearEquiv.coe_coe, Function.comp_apply, + LinearEquiv.ofBijective_apply, LinearMap.codRestrict_apply, Submodule.mapQ_apply, + sourceMap_mk] + apply (Submodule.Quotient.eq _).2 + change P.g (z : M) - P.g (z : M) ∈ K.G (p - d + 1) + simp + | add x y hx hy => simpa using congrArg₂ (· + ·) hx hy + +theorem targetTotalSuccMap_naturality (r : ℕ) : + K.targetTotalSuccMap r ∘ₗ P.targetTotalMap r = + P.targetTotalMap (r + 1) ∘ₗ K.targetTotalSuccMap r := by + apply LinearMap.ext + intro x + induction x using DirectSum.induction_on with + | zero => simp + | of p x => + rw [show DirectSum.of (fun q : ℤ => K.TargetPage r q) p x = + DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage r q) p x from rfl] + rw [LinearMap.comp_apply, LinearMap.comp_apply] + simp only [targetTotalSuccMap, DirectSum.lmap_lof] + rw [P.targetTotalMap_lof] + change K.targetTotalSuccMap r + (DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage r q) (p - d) + (P.targetMap r p x)) = + P.targetTotalMap (r + 1) + (DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage (r + 1) q) p + (K.targetSuccMap r p x)) + rw [targetTotalSuccMap, DirectSum.lmap_lof] + rw [P.targetTotalMap_lof] + apply congrArg (fun z => + DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage (r + 1) q) (p - d) z) + refine Submodule.Quotient.induction_on + ((K.boundaries r p).comap (K.G p).subtype) x ?_ + intro z + rw [P.targetMap_mk] + change K.targetSuccMap r (p - d) + (Submodule.Quotient.mk (P.targetRestricted p z)) = + Submodule.Quotient.mk (P.targetRestricted p z) + rw [targetSuccMap, Submodule.mapQ_apply] + rfl + | add x y hx hy => simpa using congrArg₂ (· + ·) hx hy + +end PageOperator + +end FilteredTwoTerm + +end AlgebraicAnalysis.FilteredTwoTermPages diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermTotalActions.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermTotalActions.lean new file mode 100644 index 0000000000..eaa6ea6be7 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermTotalActions.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermTotalPages + + +/-! +# Total direct-sum actions on filtered two-term pages + +This file packages the source and target page actions of a filtered operator +into maps on the total direct sums. The index shift is part of the map: an +operator of degree `d` sends the summand at `p` to the summand at `p - d`. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FilteredTwoTermPages + +universe u v + +variable {k : Type u} [Ring k] +variable {M : Type v} [AddCommGroup M] [Module k M] + +namespace FilteredTwoTerm + +variable (K : FilteredTwoTerm k M) + +namespace PageOperator + +variable {K} {d : ℤ} (P : K.PageOperator d) + +private theorem target_lof_transport (r : ℕ) {p q : ℤ} (h : p = q) + (x : K.TargetPage r p) : + DirectSum.lof k ℤ (fun i : ℤ => K.TargetPage r i) p x = + DirectSum.lof k ℤ (fun i : ℤ => K.TargetPage r i) q (h ▸ x) := by + subst q + rfl + +private theorem targetPageCast_eq_cast (r : ℕ) {p q : ℤ} (h : p = q) + (x : K.TargetPage r p) : + targetPageCast (K := K) r h x = h ▸ x := by + refine Submodule.Quotient.induction_on + ((K.boundaries r p).comap (K.G p).subtype) x ?_ + intro z + rw [targetPageCast_mk] + cases h + rfl + +/-- The source-page action on the total direct sum. -/ +def sourceTotalMap (r : ℕ) : K.SourceTotal r →ₗ[k] K.SourceTotal r := + DirectSum.toModule k ℤ (K.SourceTotal r) (fun p : ℤ => + (DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage r q) (p - d)).comp + (P.sourceMap r p)) + +/-- The target-page action on the total direct sum. -/ +def targetTotalMap (r : ℕ) : K.TargetTotal r →ₗ[k] K.TargetTotal r := + DirectSum.toModule k ℤ (K.TargetTotal r) (fun p : ℤ => + (DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage r q) (p - d)).comp + (P.targetMap r p)) + +@[simp] +theorem sourceTotalMap_lof (r : ℕ) (p : ℤ) (x : K.SourcePage r p) : + P.sourceTotalMap r + (DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage r q) p x) = + DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage r q) (p - d) + (P.sourceMap r p x) := by + rw [sourceTotalMap, DirectSum.toModule_lof] + rfl + +@[simp] +theorem targetTotalMap_lof (r : ℕ) (p : ℤ) (x : K.TargetPage r p) : + P.targetTotalMap r + (DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage r q) p x) = + DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage r q) (p - d) + (P.targetMap r p x) := by + rw [targetTotalMap, DirectSum.toModule_lof] + rfl + +/-- The total action intertwines the total page differential. -/ +theorem totalDrop_intertwines (r : ℕ) : + K.totalDrop r ∘ₗ P.sourceTotalMap r = + P.targetTotalMap r ∘ₗ K.totalDrop r := by + apply LinearMap.ext + intro x + induction x using DirectSum.induction_on with + | zero => simp + | of p y => + rw [show DirectSum.of (fun q : ℤ => K.SourcePage r q) p y = + DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage r q) p y from rfl] + change K.totalDrop r (P.sourceTotalMap r + (DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage r q) p y)) = + P.targetTotalMap r (K.totalDrop r + (DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage r q) p y)) + rw [P.sourceTotalMap_lof, K.totalDrop_lof, K.totalDrop_lof, + P.targetTotalMap_lof] + have h : p + (r : ℤ) - d = p - d + (r : ℤ) := by omega + rw [target_lof_transport (K := K) r h] + congr 1 + symm + convert P.targetMap_drop r p y using 1 + exact (targetPageCast_eq_cast (K := K) r _ _).symm + | add x y hx hy => simpa using congrArg₂ (· + ·) hx hy + + +private theorem source_lof_mk_eq_of_lower (r : ℕ) {p q : ℤ} (h : p = q) + (x : K.cycles r p) (y : K.cycles r q) + (hxy : (x : M) - (y : M) ∈ K.G (p + 1)) : + DirectSum.lof k ℤ (fun i => K.SourcePage r i) p (Submodule.Quotient.mk x) = + DirectSum.lof k ℤ (fun i => K.SourcePage r i) q (Submodule.Quotient.mk y) := by + subst q + congr 1 + apply (Submodule.Quotient.eq _).2 + exact hxy + +private theorem target_lof_mk_eq_of_lower (r : ℕ) {p q : ℤ} (h : p = q) + (x : K.G p) (y : K.G q) + (hxy : (x : M) - (y : M) ∈ K.G (p + 1)) : + DirectSum.lof k ℤ (fun i => K.TargetPage r i) p (Submodule.Quotient.mk x) = + DirectSum.lof k ℤ (fun i => K.TargetPage r i) q (Submodule.Quotient.mk y) := by + subst q + congr 1 + apply (Submodule.Quotient.eq _).2 + exact Submodule.mem_sup.mpr ⟨0, Submodule.zero_mem _, + (x : M) - y, hxy, by simp⟩ + +/-- Lower-order commutators vanish in the total source symbol action. -/ +theorem sourceTotalMap_commute_of_commutator_lowers {e : ℤ} + (Q : K.PageOperator e) + (hlower : ∀ p z, z ∈ K.G p → + P.g (Q.g z) - Q.g (P.g z) ∈ K.G (p - d - e + 1)) (r : ℕ) : + Commute (P.sourceTotalMap r) (Q.sourceTotalMap r) := by + apply LinearMap.ext + intro z + induction z using DirectSum.induction_on with + | zero => simp + | of p z => + change P.sourceTotalMap r (Q.sourceTotalMap r + (DirectSum.lof k ℤ (fun i => K.SourcePage r i) p z)) = + Q.sourceTotalMap r (P.sourceTotalMap r + (DirectSum.lof k ℤ (fun i => K.SourcePage r i) p z)) + rw [Q.sourceTotalMap_lof, P.sourceTotalMap_lof, + P.sourceTotalMap_lof, Q.sourceTotalMap_lof] + induction z using Submodule.Quotient.induction_on with + | _ z => + rw [Q.sourceMap_mk, P.sourceMap_mk, P.sourceMap_mk, Q.sourceMap_mk] + apply source_lof_mk_eq_of_lower (K := K) r (by omega) + change P.g (Q.g (z : M)) - Q.g (P.g (z : M)) ∈ K.G (p - e - d + 1) + simpa only [sub_sub, add_comm] using hlower p (z : M) z.property.1 + | add x y hx hy => simpa using congrArg₂ (· + ·) hx hy + +/-- Lower-order commutators vanish in the total target symbol action. -/ +theorem targetTotalMap_commute_of_commutator_lowers {e : ℤ} + (Q : K.PageOperator e) + (hlower : ∀ p z, z ∈ K.G p → + P.g (Q.g z) - Q.g (P.g z) ∈ K.G (p - d - e + 1)) (r : ℕ) : + Commute (P.targetTotalMap r) (Q.targetTotalMap r) := by + apply LinearMap.ext + intro z + induction z using DirectSum.induction_on with + | zero => simp + | of p z => + change P.targetTotalMap r (Q.targetTotalMap r + (DirectSum.lof k ℤ (fun i => K.TargetPage r i) p z)) = + Q.targetTotalMap r (P.targetTotalMap r + (DirectSum.lof k ℤ (fun i => K.TargetPage r i) p z)) + rw [Q.targetTotalMap_lof, P.targetTotalMap_lof, + P.targetTotalMap_lof, Q.targetTotalMap_lof] + induction z using Submodule.Quotient.induction_on with + | _ z => + rw [Q.targetMap_mk, P.targetMap_mk, P.targetMap_mk, Q.targetMap_mk] + apply target_lof_mk_eq_of_lower (K := K) r (by omega) + change P.g (Q.g (z : M)) - Q.g (P.g (z : M)) ∈ K.G (p - e - d + 1) + simpa only [sub_sub, add_comm] using hlower p (z : M) z.property + | add x y hx hy => simpa using congrArg₂ (· + ·) hx hy + + +end PageOperator + +end FilteredTwoTerm + +end AlgebraicAnalysis.FilteredTwoTermPages diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermTotalPages.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermTotalPages.lean new file mode 100644 index 0000000000..4d109130c7 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FilteredTwoTermTotalPages.lean @@ -0,0 +1,197 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPageEquivalences +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FilteredTwoTermPageActions +public import Mathlib.Algebra.DirectSum.Module + + +/-! +# Total direct sums of the filtered two-term pages + +The page differential has target component indexed by `p + r`. This file +packages the component maps into one direct-sum map; no successor-page +interface is assumed here. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FilteredTwoTermPages + +universe u v + +variable {k : Type u} [Ring k] +variable {M : Type v} [AddCommGroup M] [Module k M] + +namespace FilteredTwoTerm + +variable (K : FilteredTwoTerm k M) + +/-- The direct sum of the source pages at page `r`. -/ +abbrev SourceTotal (r : ℕ) := + DirectSum ℤ (fun p : ℤ => K.SourcePage r p) + +/-- The direct sum of the target pages at page `r`. -/ +abbrev TargetTotal (r : ℕ) := + DirectSum ℤ (fun p : ℤ => K.TargetPage r p) + +/-- The total page differential, with the component at `p` landing at `p+r`. + +The reindexing is expressed by the corresponding direct-sum inclusion, so the +formula keeps the target shift visible at the definition site. +-/ +def totalDrop (r : ℕ) : K.SourceTotal r →ₗ[k] K.TargetTotal r := + DirectSum.toModule k ℤ (K.TargetTotal r) (fun p : ℤ => + (DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage r q) (p + r)).comp + (K.drop r p)) + +/-- Component formula for the total differential. -/ +@[simp] +theorem totalDrop_lof (r : ℕ) (p : ℤ) (x : K.SourcePage r p) : + K.totalDrop r (DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage r q) p x) = + DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage r q) (p + r) (K.drop r p x) := by + rw [totalDrop, DirectSum.toModule_lof] + rfl + +/-- Representative formula for a source-page quotient representative. + +This compatibility lemma intentionally retains the quotient representative on +the right-hand side, although the simplifier can reduce it further. -/ +theorem totalDrop_lof_mk (r : ℕ) (p : ℤ) + (x : K.cycles r p) : + K.totalDrop r + (DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage r q) p + (Submodule.Quotient.mk x)) = + DirectSum.lof k ℤ (fun q : ℤ => K.TargetPage r q) (p + r) + (K.drop r p (Submodule.Quotient.mk x)) := by + rw [K.totalDrop_lof, K.drop_mk] + +private theorem totalDrop_apply_component (r : ℕ) (p : ℤ) + (x : K.SourceTotal r) : + K.totalDrop r x (p + r) = K.drop r p (x p) := by + classical + induction x using DirectSum.induction_on with + | zero => simp + | of q y => + rw [show DirectSum.of (fun q : ℤ => K.SourcePage r q) q y = + DirectSum.lof k ℤ (fun q : ℤ => K.SourcePage r q) q y from rfl, + K.totalDrop_lof] + by_cases h : q = p + · subst q + simp + · have hshift : q + (r : ℤ) ≠ p + (r : ℤ) := by omega + change (DFinsupp.single (q + (r : ℤ)) (K.drop r q y)) (p + r) = + K.drop r p ((DFinsupp.single q y) p) + rw [DFinsupp.single_apply, DFinsupp.single_apply, dite_eq_right hshift, dite_eq_right h] + simp + | add x y hx hy => simpa using congrArg₂ (· + ·) hx hy + + +/-- The componentwise successor map on the total source page. -/ +noncomputable def sourceTotalSuccMap (r : ℕ) : + K.SourceTotal (r + 1) →ₗ[k] K.SourceTotal r := + DirectSum.lmap (fun p => + (LinearMap.ker (K.drop r p)).subtype.comp + (K.sourceSuccEquivKerDrop r p).toLinearMap) + +theorem totalSourceSuccMap_injective (r : ℕ) : + Function.Injective (K.sourceTotalSuccMap r) := by + apply (DirectSum.lmap_injective _).mpr + intro p + exact (Submodule.subtype_injective _).comp + (K.sourceSuccEquivKerDrop r p).injective + +theorem range_totalSourceSuccMap (r : ℕ) : + (K.sourceTotalSuccMap r).range = (K.totalDrop r).ker := by + rw [sourceTotalSuccMap, DirectSum.range_lmap] + ext x + change (∀ p ∈ Set.univ, x p ∈ LinearMap.range + ((LinearMap.ker (K.drop r p)).subtype.comp + (K.sourceSuccEquivKerDrop r p).toLinearMap)) ↔ K.totalDrop r x = 0 + constructor + · intro hx + apply DFinsupp.ext + intro q + have hq : q = (q - r) + r := by omega + rw [hq, K.totalDrop_apply_component] + obtain ⟨y, hy⟩ := hx (q - r) (Set.mem_univ _) + have hmem := (K.sourceSuccEquivKerDrop r (q - r) y).property + simpa only [LinearMap.comp_apply, LinearEquiv.coe_toLinearMap, + Submodule.subtype_apply] using hy ▸ hmem + · intro hx p _ + have hzero : K.drop r p (x p) = 0 := by + rw [← K.totalDrop_apply_component, hx] + rfl + refine ⟨(K.sourceSuccEquivKerDrop r p).symm ⟨x p, hzero⟩, ?_⟩ + simp + +/-- The total successor source is the actual kernel of the total differential. -/ +noncomputable def sourceTotalSuccEquivKerDrop (r : ℕ) : + K.SourceTotal (r + 1) ≃ₗ[k] (K.totalDrop r).ker := + LinearEquiv.ofInjective (K.sourceTotalSuccMap r) + (K.totalSourceSuccMap_injective r) ≪≫ₗ + LinearEquiv.ofEq _ _ (K.range_totalSourceSuccMap r) + +private def targetReindex (r : ℕ) : + K.TargetTotal r ≃ₗ[k] DirectSum ℤ (fun p => K.TargetPage r (p + r)) := + DirectSum.lequivCongrLeft k + { toFun := fun p : ℤ => p - r + invFun := fun p => p + r + left_inv := by intro p; dsimp; omega + right_inv := by intro p; dsimp; omega } + +private theorem targetReindex_totalDrop (r : ℕ) (x : K.SourceTotal r) : + K.targetReindex r (K.totalDrop r x) = DirectSum.lmap (K.drop r) x := by + ext p + exact K.totalDrop_apply_component r p x + +/-- The componentwise quotient map on the total target page. -/ +def targetTotalSuccMap (r : ℕ) : + K.TargetTotal r →ₗ[k] K.TargetTotal (r + 1) := + DirectSum.lmap (K.targetSuccMap r) + +theorem ker_totalTargetSuccMap (r : ℕ) : + (K.targetTotalSuccMap r).ker = (K.totalDrop r).range := by + ext y + constructor + · intro hy + have hlocal : ∀ p, K.targetSuccMap r p (y p) = 0 := by + intro p + exact congrArg (fun z => z p) (LinearMap.mem_ker.mp hy) + have hmem : K.targetReindex r y ∈ (DirectSum.lmap (K.drop r)).range := by + rw [DirectSum.range_lmap] + change ∀ p ∈ Set.univ, y (p + r) ∈ (K.drop r p).range + intro p _ + rw [← K.ker_targetSuccMap_eq_range_drop] + exact hlocal (p + r) + obtain ⟨x, hx⟩ := hmem + refine ⟨x, (K.targetReindex r).injective ?_⟩ + rw [K.targetReindex_totalDrop] + exact hx + · rintro ⟨x, rfl⟩ + apply LinearMap.mem_ker.mpr + apply DFinsupp.ext + intro q + have hq : q = (q - r) + r := by omega + change K.targetSuccMap r q (K.totalDrop r x q) = 0 + rw [hq, K.totalDrop_apply_component] + apply LinearMap.mem_ker.mp + rw [K.ker_targetSuccMap_eq_range_drop] + exact ⟨x (q - r), rfl⟩ + +/-- The total successor target is the actual cokernel of the total differential. -/ +noncomputable def targetTotalSuccEquivCokerDrop (r : ℕ) : + K.TargetTotal (r + 1) ≃ₗ[k] (K.TargetTotal r ⧸ (K.totalDrop r).range) := + ((Submodule.quotEquivOfEq _ _ (K.ker_totalTargetSuccMap r).symm) ≪≫ₗ + (K.targetTotalSuccMap r).quotKerEquivOfSurjective + ((DirectSum.lmap_surjective _).mpr (K.targetSuccMap_surjective r))).symm + + +end FilteredTwoTerm + +end AlgebraicAnalysis.FilteredTwoTermPages diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/FreeSummandInduction.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FreeSummandInduction.lean new file mode 100644 index 0000000000..2cfe98acac --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/FreeSummandInduction.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.Unimodular + + +/-! +# Finite iteration of unimodular splittings + +This file packages the unconditional finite iteration of normalized +functionals. It does not assert that such a sequence can be constructed +from rank or torsion hypotheses. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.FreeSummandInduction + +variable {R : Type*} [Ring R] + +/-- The harmless zero-factor equivalence used at the start of an iteration. -/ +def emptyFactorEquiv (M : Type*) [AddCommGroup M] [Module R M] : + M ≃ₗ[R] M × (Fin 0 → R) := + { toFun := fun m ↦ (m, fun i ↦ Fin.elim0 i) + invFun := fun z ↦ z.1 + left_inv := by intro m; rfl + right_inv := by + intro z + apply Prod.ext + · rfl + · apply Subsingleton.elim + map_add' := by + intro m n + apply Prod.ext + · rfl + · apply Subsingleton.elim + map_smul' := by + intro r m + apply Prod.ext + · rfl + · apply Subsingleton.elim } + +theorem emptyFactorEquiv_apply (M : Type*) [AddCommGroup M] [Module R M] + (m : M) : emptyFactorEquiv (R := R) M m = (m, fun i ↦ Fin.elim0 i) := rfl + +/-- If every stage in a finite sequence has a specified unimodular element, +and the next module is identified with the preceding kernel, then all the +specified free rank-one factors split off simultaneously. -/ +theorem finite_unimodular_splitting + (M : ℕ → Type*) [∀ i, AddCommGroup (M i)] [∀ i, Module R (M i)] + (φ : ∀ i, M i →ₗ[R] R) (x : ∀ i, M i) + (hx : ∀ i, φ i (x i) = 1) + (hres : ∀ i, M (i + 1) ≃ₗ[R] LinearMap.ker (φ i)) : + ∀ n, Nonempty (M 0 ≃ₗ[R] M n × (Fin n → R)) := by + have hstep : ∀ i, M i ≃ₗ[R] M (i + 1) × R := by + intro i + exact (AlgebraicAnalysis.Unimodular.unimodularSplitEquiv (φ i) (x i) + (hx i)).trans ((hres i).symm.prodCongr (LinearEquiv.refl R R)) + intro n + induction n with + | zero => + exact ⟨emptyFactorEquiv (R := R) (M 0)⟩ + | succ n ih => + obtain ⟨e⟩ := ih + let factors : (R × (Fin n → R)) ≃ₗ[R] (Fin (n + 1) → R) := + (Fin.consLinearEquiv R (fun _ : Fin (n + 1) ↦ R)).trans + (LinearEquiv.refl R (Fin (n + 1) → R)) + let rearrange := + (LinearEquiv.prodAssoc R (M (n + 1)) R (Fin n → R)).trans + ((LinearEquiv.refl R (M (n + 1))).prodCongr factors) + exact ⟨e.trans (((hstep n).prodCongr + (LinearEquiv.refl R (Fin n → R))).trans rearrange)⟩ + + +end AlgebraicAnalysis.FreeSummandInduction diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/HyperplaneRestriction.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/HyperplaneRestriction.lean new file mode 100644 index 0000000000..6828916e59 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/HyperplaneRestriction.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.Finiteness.Nakayama +public import Mathlib.RingTheory.Support + + +/-! +# Algebraic hyperplane restriction + +For a finite module over a commutative ring, surjectivity of multiplication +by an element forces the module support to avoid the corresponding principal +hypersurface. The proof is the determinant trick and is independent of any +filtered or differential-operator application. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.HyperplaneRestriction + +open scoped Pointwise + +variable {R M : Type*} [CommRing R] [AddCommGroup M] [Module R M] + +/-- Degree-zero restriction to the principal hypersurface defined by `x`. -/ +abbrev Restriction (x : R) : Type _ := + M ⧸ (Ideal.span {x} • (⊤ : Submodule R M)) + +/-- Restriction vanishes exactly when multiplication by `x` is surjective. -/ +theorem restriction_subsingleton_iff_smul_surjective {x : R} : + Subsingleton (Restriction (M := M) x) ↔ + Function.Surjective fun m : M ↦ x • m := by + have hquotient : + Subsingleton (Restriction (M := M) x) ↔ + Ideal.span {x} • (⊤ : Submodule R M) = ⊤ := by + constructor + · intro h + apply Submodule.unique_quotient_iff_eq_top.mp + exact ⟨{ + default := 0 + uniq := fun y ↦ h.elim y 0 }⟩ + · intro h + obtain ⟨hunique⟩ := Submodule.unique_quotient_iff_eq_top.mpr h + exact @Unique.instSubsingleton _ hunique + rw [hquotient] + constructor + · intro htop m + have hm : m ∈ x • (⊤ : Submodule R M) := by + rw [← Submodule.ideal_span_singleton_smul, htop] + exact Submodule.mem_top + rw [← Submodule.singleton_set_smul] at hm + obtain ⟨n, hn, hmn⟩ := + (Submodule.mem_singleton_set_smul (⊤ : Submodule R M) x m).mp hm + exact ⟨n, hmn.symm⟩ + · intro hx + apply top_unique + intro m hm + obtain ⟨n, rfl⟩ := hx m + exact Submodule.smul_mem_smul + (Ideal.subset_span (by simp)) + (Submodule.mem_top : n ∈ (⊤ : Submodule R M)) + +theorem restriction_subsingleton_of_smul_surjective {x : R} + (hx : Function.Surjective fun m : M ↦ x • m) : + Subsingleton (Restriction (M := M) x) := + restriction_subsingleton_iff_smul_surjective.mpr hx + +/-- Determinant-trick certificate for a surjective scalar action. -/ +theorem exists_annihilator_sub_one_mem_span_of_smul_surjective + [Module.Finite R M] {x : R} + (hx : Function.Surjective fun m : M ↦ x • m) : + ∃ r : R, r - 1 ∈ Ideal.span {x} ∧ ∀ m : M, r • m = 0 := by + obtain ⟨r, hr, hrann⟩ := + Submodule.exists_sub_one_mem_and_smul_eq_zero_of_fg_of_le_smul + (Ideal.span {x}) (⊤ : Submodule R M) Module.Finite.fg_top (by + intro m hm + obtain ⟨n, rfl⟩ := hx m + exact Submodule.smul_mem_smul + (Ideal.subset_span (by simp)) + (Submodule.mem_top : n ∈ (⊤ : Submodule R M))) + exact ⟨r, hr, fun m ↦ hrann m Submodule.mem_top⟩ + +/-- A support prime containing `x` is impossible when `x` acts surjectively. -/ +theorem not_mem_support_of_smul_surjective_of_mem + [Module.Finite R M] {x : R} + (hx : Function.Surjective fun m : M ↦ x • m) + (p : PrimeSpectrum R) (hxp : x ∈ p.asIdeal) : + p ∉ Module.support R M := by + intro hp + obtain ⟨r, hrspan, hrann⟩ := + exists_annihilator_sub_one_mem_span_of_smul_surjective hx + have hrp : r ∈ p.asIdeal := + Module.annihilator_le_of_mem_support hp (Module.mem_annihilator.mpr hrann) + have hsubp : r - 1 ∈ p.asIdeal := + (Ideal.span_le.mpr (by simpa using hxp)) hrspan + have hone : (1 : R) ∈ p.asIdeal := by + have := p.asIdeal.sub_mem hrp hsubp + simpa using this + exact p.2.ne_top ((Ideal.eq_top_iff_one p.asIdeal).mpr hone) + +/-- The support of a finite module with surjective `x`-action avoids `V(x)`. -/ +theorem support_disjoint_zeroLocus_of_smul_surjective + [Module.Finite R M] {x : R} + (hx : Function.Surjective fun m : M ↦ x • m) : + Disjoint (Module.support R M) (PrimeSpectrum.zeroLocus ({x} : Set R)) := by + rw [Set.disjoint_left] + intro p hp hpx + rw [PrimeSpectrum.mem_zeroLocus] at hpx + exact not_mem_support_of_smul_surjective_of_mem hx p (hpx (by simp)) hp + +/-- Restriction-vanishing form of support exclusion. -/ +theorem support_disjoint_zeroLocus_of_restriction_subsingleton + [Module.Finite R M] {x : R} + (hx : Subsingleton (Restriction (M := M) x)) : + Disjoint (Module.support R M) (PrimeSpectrum.zeroLocus ({x} : Set R)) := + support_disjoint_zeroLocus_of_smul_surjective + (restriction_subsingleton_iff_smul_surjective.mp hx) + +/-- Complement-inclusion form of support exclusion. -/ +theorem support_subset_compl_zeroLocus_of_smul_surjective + [Module.Finite R M] {x : R} + (hx : Function.Surjective fun m : M ↦ x • m) : + Module.support R M ⊆ (PrimeSpectrum.zeroLocus ({x} : Set R))ᶜ := by + intro p hp hpx + exact Set.disjoint_left.mp + (support_disjoint_zeroLocus_of_smul_surjective hx) hp hpx + + +end AlgebraicAnalysis.HyperplaneRestriction diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/LocalizedKernelCokernelEquivalences.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/LocalizedKernelCokernelEquivalences.lean new file mode 100644 index 0000000000..6b106ac19b --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/LocalizedKernelCokernelEquivalences.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Module.LocalizedModule.Submodule + + +/-! +# Kernel and cokernel equivalences for module localization + +The actual localization functor preserves the two elementary constructions +needed by the successor pages. The equivalences below are obtained from the +canonical submodule and quotient localization equivalences in Mathlib. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.LocalizedKernelCokernelEquivalences + +universe u v w + +variable {R : Type u} [CommRing R] +variable {U : Type v} {V : Type w} +variable [AddCommGroup U] [AddCommGroup V] +variable [Module R U] [Module R V] + +noncomputable section + +variable (S : Submonoid R) (f : U →ₗ[R] V) + +/-- The localization of an `R`-linear map, regarded as a map over the +localized ring. -/ +noncomputable def localizedMap : LocalizedModule S U →ₗ[Localization S] + LocalizedModule S V := + (LocalizedModule.map S f).extendScalarsOfIsLocalization S (Localization S) + +@[simp] +theorem localizedMap_apply (x : LocalizedModule S U) : + localizedMap S f x = LocalizedModule.map S f x := + rfl + +/-- Localization carries an actual linear equivalence to an equivalence over +the localized ring. -/ +noncomputable def localizedEquiv (e : U ≃ₗ[R] V) : + LocalizedModule S U ≃ₗ[Localization S] LocalizedModule S V := + LinearEquiv.ofBijective (localizedMap S e.toLinearMap) (by + constructor + · simpa [localizedMap] using + (LocalizedModule.map_injective S e.toLinearMap e.injective) + · simpa [localizedMap] using + (LocalizedModule.map_surjective S e.toLinearMap e.surjective)) + +/-- Localization commutes with kernels. -/ +noncomputable def localizedKernelEquiv : + LocalizedModule S (LinearMap.ker f) ≃ₗ[Localization S] + LinearMap.ker (localizedMap S f) := by + let e₁ : (LinearMap.ker f).localized' (Localization S) S + (LocalizedModule.mkLinearMap S U) ≃ₗ[Localization S] + LocalizedModule S (LinearMap.ker f) := + Submodule.localizedEquiv S (LinearMap.ker f) + let e₂ : (LinearMap.ker f).localized' (Localization S) S + (LocalizedModule.mkLinearMap S U) ≃ₗ[Localization S] + LinearMap.ker (localizedMap S f) := + LinearEquiv.ofEq _ _ + (LinearMap.localized'_ker_eq_ker_localizedMap (Localization S) S + (LocalizedModule.mkLinearMap S U) (LocalizedModule.mkLinearMap S V) f) + exact e₁.symm.trans e₂ + +/-- Localization commutes with cokernels. -/ +noncomputable def localizedCokernelEquiv : + LocalizedModule S (V ⧸ LinearMap.range f) ≃ₗ[Localization S] + LocalizedModule S V ⧸ LinearMap.range (localizedMap S f) := by + let h : Submodule.localized S (LinearMap.range f) = + LinearMap.range (localizedMap S f) := by + have hm : + IsLocalizedModule.map S (LocalizedModule.mkLinearMap S U) + (LocalizedModule.mkLinearMap S V) f = LocalizedModule.map S f := by + ext x + induction x using LocalizedModule.induction_on with + | _ x s => + rw [IsLocalizedModule.map_LocalizedModules] + exact (LocalizedModule.map_mk S f x s).symm + simpa [localizedMap, hm] using + (LinearMap.localized'_range_eq_range_localizedMap + (Localization S) S (LocalizedModule.mkLinearMap S U) + (LocalizedModule.mkLinearMap S V) f) + let e₁ : (LocalizedModule S V ⧸ + Submodule.localized S (LinearMap.range f)) ≃ₗ[Localization S] + LocalizedModule S (V ⧸ LinearMap.range f) := + localizedQuotientEquiv S (LinearMap.range f) + let e : LocalizedModule S V ≃ₗ[Localization S] LocalizedModule S V := + LinearEquiv.refl _ _ + exact e₁.symm.trans + (Submodule.Quotient.equiv _ _ e (by simpa [e] using h)) + +end +end AlgebraicAnalysis.LocalizedKernelCokernelEquivalences diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/LocalizedMinimalSupportAvoidance.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/LocalizedMinimalSupportAvoidance.lean new file mode 100644 index 0000000000..01266261af --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/LocalizedMinimalSupportAvoidance.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Module.LocalizedModule.Basic +public import Mathlib.RingTheory.Ideal.MinimalPrime.Localization +public import Mathlib.RingTheory.Support + + +/-! +# Transport of minimal-prime support avoidance through localization + +For a finite module, localization commutes with its annihilator. The reverse +inclusion uses a finite generating set to clear all denominators at once. +Minimal-prime avoidance then follows from the ordinary minimal-prime +correspondence for a localization. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.LocalizedMinimalSupportAvoidance + +noncomputable section + +variable {C E : Type*} [CommRing C] [AddCommGroup E] [Module C E] + +/-- The annihilator of a finite module commutes with localization. -/ +theorem annihilator_localizedModule + [Module.Finite C E] (S : Submonoid C) : + Module.annihilator (Localization S) (LocalizedModule S E) = + Ideal.map (algebraMap C (Localization S)) (Module.annihilator C E) := by + apply le_antisymm + · intro z hz + obtain ⟨⟨c, d⟩, rfl⟩ := IsLocalization.mk'_surjective S z + obtain ⟨gens, hgens⟩ := (inferInstance : Module.Finite C E) + have hclear : ∀ e ∈ gens, ∃ u : S, u • (c • e) = 0 := by + intro e he + have hzero : + IsLocalization.mk' (Localization S) c d • LocalizedModule.mk e 1 = 0 := + Module.mem_annihilator.mp hz _ + rw [IsLocalizedModule.mk_eq_mk'] at hzero + rw [IsLocalizedModule.mk'_smul_mk', IsLocalizedModule.mk'_eq_zero'] at hzero + exact hzero + choose u hu using hclear + let t : S := gens.attach.prod fun e => u e e.property + have htc : (t : C) * c ∈ Module.annihilator C E := by + rw [Module.mem_annihilator] + intro e + refine Submodule.span_induction ?_ (smul_zero _) ?_ ?_ + (show e ∈ Submodule.span C (gens : Set E) by rw [hgens]; trivial) + · intro e he + obtain ⟨v, hv⟩ := Finset.dvd_prod_of_mem + (fun a : gens => u a a.property) (Finset.mem_attach gens ⟨e, he⟩) + have hue : (((u e he : S) : C) * c) • e = 0 := by + simpa only [mul_smul, Submonoid.smul_def] using hu e he + change (((t : S) : C) * c) • e = 0 + rw [show t = gens.attach.prod (fun a => u a a.property) by rfl, hv, + Submonoid.coe_mul, mul_comm ((u e he : S) : C) (v : C), + mul_assoc, mul_smul, hue, smul_zero] + · intro e₁ e₂ _ _ he₁ he₂ + rw [smul_add, he₁, he₂, zero_add] + · intro a e _ he + rw [smul_comm, he, smul_zero] + rw [IsLocalization.mk'_mem_map_algebraMap_iff] + exact ⟨t, t.property, htc⟩ + · rw [Ideal.map_le_iff_le_comap] + intro c hc + rw [Ideal.mem_comap, Module.mem_annihilator] + intro y + induction y using LocalizedModule.induction_on with + | _ e d => + rw [IsLocalizedModule.mk_eq_mk'] + rw [← IsLocalization.mk'_one (M := S), IsLocalizedModule.mk'_smul_mk', + Module.mem_annihilator.mp hc e] + simp + +/-- Minimal-prime avoidance survives localization. -/ +theorem localized_minimalPrime_avoids + [Module.Finite C E] + (S : Submonoid C) (x : C) + (havoid : ∀ p ∈ (Module.annihilator C E).minimalPrimes, x ∉ p) : + ∀ Q ∈ (Module.annihilator (Localization S) + (LocalizedModule S E)).minimalPrimes, + algebraMap C (Localization S) x ∉ Q := by + intro Q hQ + have hQmap : Q ∈ + (Ideal.map (algebraMap C (Localization S)) + (Module.annihilator C E)).minimalPrimes := by + rw [← annihilator_localizedModule S] + exact hQ + have hQunder : + Ideal.under C Q ∈ (Module.annihilator C E).minimalPrimes := by + rw [IsLocalization.minimalPrimes_map S + (Localization S) (Module.annihilator C E)] at hQmap + exact hQmap + intro hxQ + exact havoid (Ideal.under C Q) hQunder hxQ + +end + +end AlgebraicAnalysis.LocalizedMinimalSupportAvoidance diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/MinimalPrimeFiniteLengthLocalization.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/MinimalPrimeFiniteLengthLocalization.lean new file mode 100644 index 0000000000..21e278d364 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/MinimalPrimeFiniteLengthLocalization.lean @@ -0,0 +1,224 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.FiniteLength +public import Mathlib.Algebra.Module.Torsion.Basic +public import Mathlib.RingTheory.Finiteness.Ideal +public import Mathlib.RingTheory.Ideal.MinimalPrime.Localization +public import Mathlib.RingTheory.Localization.Finiteness +public import Mathlib.RingTheory.Noetherian.Basic +public import Mathlib.RingTheory.Support + + +/-! +# Finite length at a minimal prime of a finite module + +This file isolates the commutative-algebra localization statement used later: +if `P` is minimal over the annihilator of a finite module, then localization at +`P` is nonzero and has finite length. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.MinimalPrimeFiniteLengthLocalization + +noncomputable section + +open scoped Pointwise + +variable {A M : Type*} [CommRing A] [AddCommGroup M] [Module A M] + +/-- A finite module over a Noetherian local ring has finite length as soon as +a power of the maximal ideal annihilates it. -/ +theorem finiteLength_of_maximalIdeal_pow_smul_eq_bot + [IsLocalRing A] [IsNoetherianRing A] [Module.Finite A M] + {n : ℕ} + (hpow : (IsLocalRing.maximalIdeal A ^ n) • (⊤ : Submodule A M) = ⊥) : + IsFiniteLength A M := by + induction n generalizing M with + | zero => + have htop : (⊤ : Submodule A M) = ⊥ := by simpa using hpow + have : Subsingleton M := + ⟨fun x y ↦ by + have hx : x = 0 := by + have : x ∈ (⊥ : Submodule A M) := by rw [← htop]; trivial + simpa using this + have hy : y = 0 := by + have : y ∈ (⊥ : Submodule A M) := by rw [← htop]; trivial + simpa using this + exact hx.trans hy.symm⟩ + exact .of_subsingleton + | succ n ih => + let m : Ideal A := IsLocalRing.maximalIdeal A + let N : Submodule A M := m • (⊤ : Submodule A M) + have hNpow : (m ^ n) • (⊤ : Submodule A N) = ⊥ := by + rw [Submodule.eq_bot_iff] + intro x hx + apply Subtype.ext + change (x : M) = 0 + have hx' : (x : M) ∈ (m ^ n) • N := + (Submodule.mem_smul_top_iff (I := m ^ n) N x).mp hx + have hxbot : (x : M) ∈ (⊥ : Submodule A M) := by + rw [← hpow, show IsLocalRing.maximalIdeal A = m from rfl, + pow_succ, mul_smul] + exact hx' + simpa using hxbot + have hNfinite : IsFiniteLength A N := ih hNpow + let hQtor : Module.IsTorsionBySet A (M ⧸ N) m := by + simpa only [N] using Module.isTorsionBySet_quotient_ideal_smul M m + let : m.IsMaximal := by dsimp [m]; infer_instance + let : Module (A ⧸ m) (M ⧸ N) := hQtor.module + let : IsScalarTower A (A ⧸ m) (M ⧸ N) := hQtor.isScalarTower + let : Field (A ⧸ m) := Ideal.Quotient.field m + have : Module.Finite A (M ⧸ N) := Module.Finite.quotient A N + have : Module.Finite (A ⧸ m) (M ⧸ N) := + Module.Finite.of_restrictScalars_finite A (A ⧸ m) (M ⧸ N) + have hQartinianQuot : IsArtinian (A ⧸ m) (M ⧸ N) := inferInstance + have hQartinian : IsArtinian A (M ⧸ N) := by + let e : Submodule (A ⧸ m) (M ⧸ N) ≃o Submodule A (M ⧸ N) := + { Submodule.restrictScalarsEmbedding A (A ⧸ m) (M ⧸ N) with + invFun := fun p ↦ + { carrier := p + add_mem' := p.add_mem + zero_mem' := p.zero_mem + smul_mem' := by + rintro ⟨a⟩ x hx + exact p.smul_mem a hx } + left_inv := by intro p; ext; rfl + right_inv := by intro p; ext; rfl } + exact e.symm.toOrderEmbedding.wellFounded hQartinianQuot + rw [isFiniteLength_iff_isNoetherian_isArtinian] + exact ⟨inferInstance, + (isArtinian_iff_submodule_quotient N).mpr + ⟨(isFiniteLength_iff_isNoetherian_isArtinian.mp hNfinite).2, hQartinian⟩⟩ + +variable {R G : Type*} [CommRing R] + [AddCommGroup G] [Module R G] + +/-- Localization preserves finite generation for the canonical localized +module. -/ +theorem localizedModule_finite [Module.Finite R G] + (P : Ideal R) [P.IsPrime] : + Module.Finite (Localization P.primeCompl) + (LocalizedModule P.primeCompl G) := by + exact Module.Finite.of_isLocalizedModule P.primeCompl + (LocalizedModule.mkLinearMap P.primeCompl G) + +/-- A minimal prime over the annihilator belongs to the support, so the +corresponding localization is nonzero. -/ +theorem localizedModule_nontrivial + [Module.Finite R G] (P : Ideal R) [P.IsPrime] + (hP : P ∈ (Module.annihilator R G).minimalPrimes) : + Nontrivial (LocalizedModule P.primeCompl G) := by + let p : PrimeSpectrum R := ⟨P, inferInstance⟩ + have hp : p ∈ Module.support R G := + Module.mem_support_iff_of_finite.mpr hP.1.2 + simpa [p] using (Module.mem_support_iff.mp hp) + +/-- At a minimal prime over the module annihilator, the localized maximal +ideal lies in the radical of the mapped annihilator. -/ +theorem maximalIdeal_le_radical_map_annihilator + (P : Ideal R) [P.IsPrime] + (hP : P ∈ (Module.annihilator R G).minimalPrimes) : + IsLocalRing.maximalIdeal (Localization P.primeCompl) ≤ + (Ideal.map (algebraMap R (Localization P.primeCompl)) + (Module.annihilator R G)).radical := by + rw [← Localization.AtPrime.map_eq_maximalIdeal] + rw [Ideal.radical_eq_sInf, le_sInf_iff] + rintro q ⟨hmap, hqprime⟩ + obtain ⟨hcomapPrime, hcomapLe⟩ := + ((IsLocalization.AtPrime.orderIsoOfPrime + (Localization P.primeCompl) P) ⟨q, hqprime⟩).2 + rw [Ideal.map_le_iff_le_comap] at hmap ⊢ + exact hP.2 ⟨hcomapPrime, hmap⟩ hcomapLe + +/-- Mapping the original annihilator into the localization gives elements +that annihilate every localized fraction. -/ +theorem map_annihilator_le_localized_annihilator + (P : Ideal R) [P.IsPrime] : + Ideal.map (algebraMap R (Localization P.primeCompl)) + (Module.annihilator R G) ≤ + Module.annihilator (Localization P.primeCompl) + (LocalizedModule P.primeCompl G) := by + rw [Ideal.map_le_iff_le_comap] + intro r hr + rw [Ideal.mem_comap, Module.mem_annihilator] + intro z + induction z using LocalizedModule.induction_on with + | _ g s => + change Localization.mk r (1 : P.primeCompl) • + LocalizedModule.mk g s = 0 + rw [LocalizedModule.mk_smul_mk] + have hrg : r • g = 0 := Module.mem_annihilator.mp hr g + rw [hrg, LocalizedModule.zero_mk] + +/-- A power of the localized maximal ideal annihilates the localized finite +module. -/ +theorem exists_maximalIdeal_pow_le_localized_annihilator + [IsNoetherianRing R] + (P : Ideal R) [P.IsPrime] + (hP : P ∈ (Module.annihilator R G).minimalPrimes) : + ∃ n : ℕ, IsLocalRing.maximalIdeal (Localization P.primeCompl) ^ n ≤ + Module.annihilator (Localization P.primeCompl) + (LocalizedModule P.primeCompl G) := by + let A := Localization P.primeCompl + have : IsNoetherianRing A := + IsLocalization.isNoetherianRing P.primeCompl A inferInstance + have hrad : IsLocalRing.maximalIdeal A ≤ + (Module.annihilator A (LocalizedModule P.primeCompl G)).radical := + (maximalIdeal_le_radical_map_annihilator P hP).trans + (Ideal.radical_mono (map_annihilator_le_localized_annihilator P)) + exact Ideal.exists_pow_le_of_le_radical_of_fg hrad + (Module.Finite.iff_fg.mp (inferInstance : + Module.Finite A (IsLocalRing.maximalIdeal A))) + +/-- The localized module at a minimal prime over its annihilator has finite +length over the local ring. -/ +theorem localizedModule_isFiniteLength + [IsNoetherianRing R] [Module.Finite R G] + (P : Ideal R) [P.IsPrime] + (hP : P ∈ (Module.annihilator R G).minimalPrimes) : + IsFiniteLength (Localization P.primeCompl) + (LocalizedModule P.primeCompl G) := by + let A := Localization P.primeCompl + have : IsNoetherianRing A := + IsLocalization.isNoetherianRing P.primeCompl A inferInstance + have : Module.Finite A (LocalizedModule P.primeCompl G) := + localizedModule_finite P + obtain ⟨n, hn⟩ := exists_maximalIdeal_pow_le_localized_annihilator P hP + have hann : Module.annihilator A (LocalizedModule P.primeCompl G) • + (⊤ : Submodule A (LocalizedModule P.primeCompl G)) = ⊥ := by + rw [← Submodule.annihilator_top] + exact Submodule.annihilator_smul + (⊤ : Submodule A (LocalizedModule P.primeCompl G)) + apply finiteLength_of_maximalIdeal_pow_smul_eq_bot (n := n) + apply le_antisymm + · calc + IsLocalRing.maximalIdeal A ^ n • + (⊤ : Submodule A (LocalizedModule P.primeCompl G)) + ≤ Module.annihilator A (LocalizedModule P.primeCompl G) • + (⊤ : Submodule A (LocalizedModule P.primeCompl G)) := + Submodule.smul_mono hn le_rfl + _ = ⊥ := hann + · exact bot_le + +/-- The load-bearing package: localization at a minimal prime over the +annihilator is simultaneously nonzero and of finite length. -/ +theorem localizedModule_nontrivial_and_isFiniteLength + [IsNoetherianRing R] [Module.Finite R G] + (P : Ideal R) [P.IsPrime] + (hP : P ∈ (Module.annihilator R G).minimalPrimes) : + Nontrivial (LocalizedModule P.primeCompl G) ∧ + IsFiniteLength (Localization P.primeCompl) + (LocalizedModule P.primeCompl G) := + ⟨localizedModule_nontrivial P hP, localizedModule_isFiniteLength P hP⟩ + + +end + +end AlgebraicAnalysis.MinimalPrimeFiniteLengthLocalization diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/MinimalSupportExistence.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/MinimalSupportExistence.lean new file mode 100644 index 0000000000..453ef1bd74 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/MinimalSupportExistence.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.Ideal.MinimalPrime.Basic +public import Mathlib.RingTheory.Support + + +/-! +# Existence of a minimal support prime + +A nontrivial finite module over a commutative Noetherian ring has a prime in +its support which is minimal among the support primes. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.MinimalSupportExistence + +noncomputable section + +variable {R U : Type*} [CommRing R] [AddCommGroup U] [Module R U] +theorem exists_minimal_support_prime + [Module.Finite R U] [Nontrivial U] : + ∃ q : PrimeSpectrum R, + q ∈ Module.support R U ∧ + ∀ p ∈ Module.support R U, p.asIdeal ≤ q.asIdeal → + q.asIdeal ≤ p.asIdeal := by + have hann : Module.annihilator R U ≠ ⊤ := by + intro h + have hs : Subsingleton U := Module.annihilator_eq_top_iff.mp h + exact not_subsingleton_iff_nontrivial.mpr inferInstance hs + obtain ⟨q, hq⟩ := + (Module.annihilator R U).nonempty_minimalPrimes hann + let Q : PrimeSpectrum R := ⟨q, hq.1.1⟩ + refine ⟨Q, Module.mem_support_iff_of_finite.mpr hq.1.2, ?_⟩ + intro p hp hpq + exact hq.2 + ⟨p.isPrime, Module.mem_support_iff_of_finite.mp hp⟩ hpq + + +end +end AlgebraicAnalysis.MinimalSupportExistence diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/MinimalSupportKernelCokernelLengths.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/MinimalSupportKernelCokernelLengths.lean new file mode 100644 index 0000000000..ce10f19037 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/MinimalSupportKernelCokernelLengths.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.EndomorphismKernelSupportOverBase +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MinimalPrimeFiniteLengthLocalization +public import Mathlib.RingTheory.Support + + +/-! +# Finite length of a localized kernel and cokernel + +This is the small commutative-algebra adapter needed when the finite module is +over a larger coefficient algebra. Finiteness over the base is supplied +explicitly; no restriction-of-scalars finiteness of the ambient module is +used. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis + +open scoped Pointwise + +noncomputable section + +private theorem localized_isFiniteLength_of_minimal_support + {R N : Type*} [CommRing R] [AddCommGroup N] [Module R N] + [IsNoetherianRing R] [Module.Finite R N] + (q : PrimeSpectrum R) + (hqmem : q ∈ Module.support R N) + (hq : ∀ p ∈ Module.support R N, p.asIdeal ≤ q.asIdeal → + q.asIdeal ≤ p.asIdeal) : + IsFiniteLength (Localization q.asIdeal.primeCompl) + (LocalizedModule q.asIdeal.primeCompl N) := by + have hqmem' : q ∈ Module.support R N := hqmem + have hqmem := hqmem' + have hmin : q.asIdeal ∈ (Module.annihilator R N).minimalPrimes := by + obtain ⟨p, hp, hpq⟩ := + Ideal.exists_minimalPrimes_le + (Module.mem_support_iff_of_finite.mp hqmem) + have hpprime : p.IsPrime := hp.1.1 + let p' : PrimeSpectrum R := ⟨p, hpprime⟩ + have hp'supp : p' ∈ Module.support R N := + Module.mem_support_iff_of_finite.mpr hp.1.2 + have hqp : q.asIdeal ≤ p := hq p' hp'supp hpq + have heq : p = q.asIdeal := le_antisymm hpq hqp + simpa [heq] using hp + exact MinimalPrimeFiniteLengthLocalization.localizedModule_isFiniteLength + q.asIdeal hmin + +theorem localized_kernel_and_cokernel_isFiniteLength + {R C E : Type*} [CommRing R] [CommRing C] [Algebra R C] + [AddCommGroup E] [Module C E] [Module R E] [IsScalarTower R C E] + [IsNoetherianRing R] [IsNoetherianRing C] [Module.Finite C E] + (f : Module.End C E) + [Module.Finite R (LinearMap.ker (f.restrictScalars R))] + [Module.Finite R (E ⧸ LinearMap.range (f.restrictScalars R))] + (q : PrimeSpectrum R) + (hqmem : q ∈ Module.support R (E ⧸ LinearMap.range (f.restrictScalars R))) + (hq : ∀ p ∈ Module.support R (E ⧸ LinearMap.range (f.restrictScalars R)), + p.asIdeal ≤ q.asIdeal → q.asIdeal ≤ p.asIdeal) : + IsFiniteLength (Localization q.asIdeal.primeCompl) + (LocalizedModule q.asIdeal.primeCompl + (E ⧸ LinearMap.range (f.restrictScalars R))) ∧ + IsFiniteLength (Localization q.asIdeal.primeCompl) + (LocalizedModule q.asIdeal.primeCompl + (LinearMap.ker (f.restrictScalars R))) := by + have hc := localized_isFiniteLength_of_minimal_support q hqmem hq + have hksub := + endomorphism_kernel_support_subset_cokernel_support_over_base + (R := R) (C := C) (E := E) f + by_cases hk : q ∈ Module.support R (LinearMap.ker (f.restrictScalars R)) + · have hqk : ∀ p ∈ Module.support R (LinearMap.ker (f.restrictScalars R)), + p.asIdeal ≤ q.asIdeal → q.asIdeal ≤ p.asIdeal := by + intro p hp hpq + exact hq p (hksub hp) hpq + exact ⟨hc, localized_isFiniteLength_of_minimal_support q hk hqk⟩ + · have hsub : Subsingleton (LocalizedModule q.asIdeal.primeCompl + (LinearMap.ker (f.restrictScalars R))) := + not_nontrivial_iff_subsingleton.mp (by + intro h + exact hk (Module.mem_support_iff.mpr h)) + let := hsub + exact ⟨hc, IsFiniteLength.of_subsingleton⟩ + + +end +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/MonicAnnihilatorFinite.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/MonicAnnihilatorFinite.lean new file mode 100644 index 0000000000..fe697fef1e --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/MonicAnnihilatorFinite.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.AdjoinRoot +public import Mathlib.Algebra.Module.Torsion.Basic +public import Mathlib.RingTheory.Finiteness.Basic +public import Mathlib.RingTheory.Polynomial.Basic + + +/-! +# Finiteness from a monic annihilator + +A finite polynomial-ring module annihilated by a monic polynomial is finite +over the coefficient ring. This is the algebraic finiteness step for the +normal covariable; no characteristic-support assertion is assumed. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.MonicAnnihilatorFinite + +open Polynomial + +theorem finite_of_monic_annihilator {R E : Type*} [CommRing R] + [AddCommGroup E] [Module R E] [Module R[X] E] + [IsScalarTower R R[X] E] [Module.Finite R[X] E] + (g : R[X]) (hg : g.Monic) (hkill : ∀ z : E, g • z = 0) : + Module.Finite R E := by + have ht : Module.IsTorsionBySet R[X] E (Ideal.span {g}) := by + rw [Module.isTorsionBySet_span_singleton_iff] + exact hkill + let := ht.module + let : IsScalarTower R[X] (R[X] ⧸ Ideal.span {g}) E := + ht.isScalarTower + let : IsScalarTower R (R[X] ⧸ Ideal.span {g}) E := + ht.isScalarTower + let : Module.Finite (R[X] ⧸ Ideal.span {g}) E := + Module.Finite.of_restrictScalars_finite R[X] (R[X] ⧸ Ideal.span {g}) E + let := hg.finite_quotient + exact Module.Finite.trans (R[X] ⧸ Ideal.span {g}) E + +/-- A finite module killed by the polynomial variable is finite over the +coefficient ring. -/ +theorem finite_of_variable_annihilates {R E : Type*} [CommRing R] + [AddCommGroup E] [Module R E] [Module R[X] E] + [IsScalarTower R R[X] E] [Module.Finite R[X] E] + (hkill : ∀ z : E, (X : R[X]) • z = 0) : Module.Finite R E := + finite_of_monic_annihilator X monic_X hkill + +/-- Both terms of the principal Koszul homology are finite over the +coefficient ring, although the ambient module need not be. -/ +theorem finite_kernel_and_cokernel_variable {R E : Type*} [CommRing R] + [IsNoetherianRing R] [AddCommGroup E] [Module R E] [Module R[X] E] + [IsScalarTower R R[X] E] [Module.Finite R[X] E] : + Module.Finite R (LinearMap.ker (LinearMap.lsmul R[X] E X)) ∧ + Module.Finite R (E ⧸ LinearMap.range (LinearMap.lsmul R[X] E X)) := by + let f : Module.End R[X] E := LinearMap.lsmul R[X] E X + constructor + · apply finite_of_variable_annihilates + intro z + apply Subtype.ext + exact LinearMap.mem_ker.mp z.property + · apply finite_of_variable_annihilates + intro z + induction z using Submodule.Quotient.induction_on with + | _ z => + rw [← Submodule.Quotient.mk_smul, Submodule.Quotient.mk_eq_zero] + exact ⟨z, rfl⟩ + +end AlgebraicAnalysis.MonicAnnihilatorFinite diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/PrincipalKoszulFiniteTorsion.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/PrincipalKoszulFiniteTorsion.lean new file mode 100644 index 0000000000..db5be09c48 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/PrincipalKoszulFiniteTorsion.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulPositivity + + +/-! +# Finite power torsion for a principal Koszul endomorphism + +This file isolates the reusable algebra needed after tangential localization. +The ambient module need not be finite over the ring in which lengths are +measured. It is enough that the first kernel has finite length: all finite +power kernels then have finite length by devissage. + +The final theorem deliberately assumes that the actual residual quotient is +nonzero. It proves only the strict length inequality and makes no +noncharacteristic-support or geometric nonvanishing claim. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.PrincipalKoszulFiniteTorsion + +open AlgebraicAnalysis.PrincipalKoszulPositivity + +noncomputable section + +universe u v + +variable {R : Type u} {E : Type v} +variable [CommRing R] +variable [AddCommGroup E] [Module R E] + +/-- If the first kernel of an endomorphism is Noetherian, then so is the +kernel of every finite power. No finiteness hypothesis is imposed on the +ambient module. -/ +theorem isNoetherian_kernel_power (f : Module.End R E) + [IsNoetherian R f.ker] (n : ℕ) : IsNoetherian R (f ^ n).ker := by + induction n with + | zero => + rw [pow_zero, Module.End.one_eq_id, LinearMap.ker_id] + infer_instance + | succ n ih => + let := ih + have hle : f.ker ≤ (f ^ (n + 1)).ker := by + intro z hz + rw [LinearMap.mem_ker, pow_succ, Module.End.mul_apply, + LinearMap.mem_ker.mp hz, map_zero] + let i : f.ker →ₗ[R] (f ^ (n + 1)).ker := Submodule.inclusion hle + let g : (f ^ (n + 1)).ker →ₗ[R] (f ^ n).ker := f.restrict (by + intro z hz + rw [LinearMap.mem_ker] at hz ⊢ + simpa [pow_succ, Module.End.mul_apply] using hz) + have hexact : i.range = g.ker := by + ext z + constructor + · rintro ⟨w, rfl⟩ + apply Subtype.ext + exact LinearMap.mem_ker.mp w.property + · intro hz + have hz0 : f z.val = 0 := congrArg Subtype.val (LinearMap.mem_ker.mp hz) + exact ⟨⟨z.val, hz0⟩, rfl⟩ + exact isNoetherian_of_range_eq_ker i g hexact + +/-- Finite length of the first kernel propagates to every finite power +kernel, even when the ambient module is not finite over `R`. -/ +theorem isFiniteLength_kernel_power (f : Module.End R E) + (hfinite : IsFiniteLength R f.ker) (n : ℕ) : + IsFiniteLength R (f ^ n).ker := by + have hfirst := isFiniteLength_iff_isNoetherian_isArtinian.mp hfinite + let : IsNoetherian R f.ker := hfirst.1 + let : IsArtinian R f.ker := hfirst.2 + exact isFiniteLength_iff_isNoetherian_isArtinian.mpr + ⟨isNoetherian_kernel_power f n, isArtinian_kernel_power f n⟩ + +/-- A stable finite power kernel contributes the same length to the kernel and +cokernel. If the actual quotient left after removing that torsion and the +range is nonzero, the principal Koszul Euler length is strictly positive. + +The nonzero quotient is an explicit input; this theorem does not manufacture +it from a support or noncharacteristic hypothesis. -/ +theorem length_cokernel_gt_kernel_of_stable_power_and_nonzero + (f : Module.End R E) (n : ℕ) + (hfinite : IsFiniteLength R f.ker) + (hstable : LinearMap.ker (f ^ n) = LinearMap.ker (f ^ (n + 1))) + (hnonzero : Nontrivial (E ⧸ ((f ^ n).ker ⊔ f.range))) : + Module.length R (E ⧸ f.range) > Module.length R f.ker := by + have hfirstparts := isFiniteLength_iff_isNoetherian_isArtinian.mp hfinite + let : IsNoetherian R f.ker := hfirstparts.1 + let : IsArtinian R f.ker := hfirstparts.2 + let T : Submodule R E := (f ^ n).ker + have hTfinite : IsFiniteLength R T := isFiniteLength_kernel_power f hfinite n + have hTparts := isFiniteLength_iff_isNoetherian_isArtinian.mp hTfinite + let : IsNoetherian R T := hTparts.1 + let : IsArtinian R T := hTparts.2 + have hcomap : T.comap f = T := by + ext z + rw [Submodule.mem_comap] + change (f ^ n) (f z) = 0 ↔ (f ^ n) z = 0 + rw [← Module.End.mul_apply, (Commute.self_pow f n).eq.symm, + Module.End.mul_apply] + simpa [Module.End.pow_apply, Function.iterate_succ_apply'] using + congrArg (fun K : Submodule R E ↦ z ∈ K) hstable.symm + let : Nontrivial (E ⧸ (T ⊔ f.range)) := hnonzero + have hpositive : 0 < Module.length R (E ⧸ (T ⊔ f.range)) := + Module.length_pos + rw [length_cokernel_eq_kernel_add_regular_quotient f T hcomap] + simpa [add_comm] using + ENat.lt_add_left (Module.length_ne_top (R := R) (M := f.ker)) hpositive + + +end + +end AlgebraicAnalysis.PrincipalKoszulFiniteTorsion diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/PrincipalKoszulMinimalSupportPositivity.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/PrincipalKoszulMinimalSupportPositivity.lean new file mode 100644 index 0000000000..ed6b0a5271 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/PrincipalKoszulMinimalSupportPositivity.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulSupportOverBase +public import Mathlib.RingTheory.Support + + +/-! +# Principal Koszul positivity from minimal support + +The support primes used by the strict length argument are produced from the +finite `C`-module itself. In particular, no finiteness of `E` over the base +ring `R` is needed. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.PrincipalKoszulMinimalSupportPositivity + +open AlgebraicAnalysis.PrincipalKoszulSupportOverBase + +noncomputable section + +universe u v w + +variable {R : Type u} {C : Type v} {E : Type w} +variable [CommRing R] [CommRing C] [Algebra R C] +variable [AddCommGroup E] [Module C E] [Module R E] +variable [IsScalarTower R C E] + +/-- Minimal support primes of `E` produce the ordered support pair needed by +the principal Koszul positivity argument. -/ +theorem length_cokernel_gt_kernel_of_minimal_support + [IsNoetherianRing C] [Module.Finite C E] + (x : C) + (hmin : ∀ p ∈ (Module.annihilator C E).minimalPrimes, + x ∉ p) + (hnonzero : Nontrivial (QuotSMulTop x E)) + (hfinite : IsFiniteLength R + (LinearMap.ker ((LinearMap.lsmul C E x).restrictScalars R))) : + Module.length R (E ⧸ LinearMap.range ((LinearMap.lsmul C E x).restrictScalars R)) > + Module.length R (LinearMap.ker ((LinearMap.lsmul C E x).restrictScalars R)) := by + have : Nontrivial (QuotSMulTop x E) := hnonzero + obtain ⟨q, hqquot⟩ := Module.nonempty_support_of_nontrivial + (R := C) (M := QuotSMulTop x E) + have hq := hqquot + rw [Module.support_quotSMulTop] at hq + have hqE : q ∈ Module.support C E := hq.1 + have han : Module.annihilator C E ≤ q.asIdeal := + Module.mem_support_iff_of_finite.mp hqE + obtain ⟨p, hpmin, hpq⟩ := + Ideal.exists_minimalPrimes_le (I := Module.annihilator C E) + (J := q.asIdeal) han + let p' : PrimeSpectrum C := ⟨p, hpmin.1.1⟩ + have hp' : p' ∈ Module.support C E := + Module.mem_support_iff_of_finite.mpr hpmin.1.2 + have hpq' : p' ≤ q := hpq + have hxp : x ∉ p'.asIdeal := by + exact hmin p hpmin + exact length_cokernel_gt_kernel_of_support_over_base + x p' q hp' hpq' hxp hqquot hfinite + + +end +end AlgebraicAnalysis.PrincipalKoszulMinimalSupportPositivity diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/PrincipalKoszulPositivity.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/PrincipalKoszulPositivity.lean new file mode 100644 index 0000000000..753739b18f --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/PrincipalKoszulPositivity.lean @@ -0,0 +1,329 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.MinimalPrimeFiniteLengthLocalization +public import Mathlib.RingTheory.Length +public import Mathlib.RingTheory.Noetherian.Defs + + +/-! +# Positivity for a principal Koszul quotient + +Stable power torsion contributes equally to kernel and cokernel length. +After removing it, local Nakayama gives a positive residual cokernel when +a support prime avoids the scalar. The proof retains embedded torsion; +it does not infer injectivity from minimal-prime avoidance. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.PrincipalKoszulPositivity + +open scoped Pointwise + +noncomputable section + +universe u v + +variable {R : Type u} {E : Type v} +variable [CommRing R] +variable [AddCommGroup E] [Module R E] + +/-- Scalar multiplication, viewed as a linear endomorphism. -/ +abbrev scalarEnd (x : R) : E →ₗ[R] E := LinearMap.lsmul R E x + +/-- +The `x`-power torsion in a Noetherian module is already the kernel of one +finite power of `x`. This is the stabilization step needed before passing to +the quotient on which `x` acts injectively; it does not discard embedded +torsion. +-/ +theorem exists_stable_kernel_power [IsNoetherian R E] (f : Module.End R E) : + ∃ n : ℕ, LinearMap.ker (f ^ n) = LinearMap.ker (f ^ (n + 1)) := by + obtain ⟨n, hn⟩ := + (monotone_stabilizes_iff_noetherian.mpr (inferInstance : IsNoetherian R E)) + f.iterateKer + exact ⟨n, hn (n + 1) (Nat.le_add_right n 1)⟩ + +/-- Specialization of kernel stabilization to multiplication by a scalar. -/ +theorem exists_stable_kernel_power_smul [IsNoetherian R E] (x : R) : + ∃ n : ℕ, + LinearMap.ker ((scalarEnd (E := E) x) ^ n) = + LinearMap.ker ((scalarEnd (E := E) x) ^ (n + 1)) := + exists_stable_kernel_power (scalarEnd (E := E) x) + +/-- Finite-length coordinate kernel controls all finite power-torsion layers. +The Artinian assertion is the nontrivial half; Noetherianity is inherited +from the ambient finite module in the applications. -/ +theorem isArtinian_kernel_power (f : Module.End R E) + [IsArtinian R f.ker] (n : ℕ) : IsArtinian R (f ^ n).ker := by + induction n with + | zero => + rw [pow_zero, Module.End.one_eq_id, LinearMap.ker_id] + infer_instance + | succ n ih => + let := ih + have hle : f.ker ≤ (f ^ (n + 1)).ker := by + intro z hz + rw [LinearMap.mem_ker, pow_succ, Module.End.mul_apply, + LinearMap.mem_ker.mp hz, map_zero] + let i : f.ker →ₗ[R] (f ^ (n + 1)).ker := Submodule.inclusion hle + let g : (f ^ (n + 1)).ker →ₗ[R] (f ^ n).ker := f.restrict (by + intro z hz + rw [LinearMap.mem_ker] at hz ⊢ + simpa [pow_succ, Module.End.mul_apply] using hz) + have hexact : i.range = g.ker := by + ext z + constructor + · rintro ⟨w, rfl⟩ + apply Subtype.ext + exact LinearMap.mem_ker.mp w.property + · intro hz + have hz0 : f z.val = 0 := congrArg Subtype.val (LinearMap.mem_ker.mp hz) + exact ⟨⟨z.val, hz0⟩, rfl⟩ + exact isArtinian_of_range_eq_ker i g hexact + +/-- Once two consecutive power kernels agree, the induced endomorphism on +the quotient by the stabilized kernel is injective. -/ +theorem quotient_by_stable_kernel_power_injective (f : Module.End R E) (n : ℕ) + (hstable : LinearMap.ker (f ^ n) = LinearMap.ker (f ^ (n + 1))) : + Function.Injective + ((LinearMap.ker (f ^ n)).mapQ (LinearMap.ker (f ^ n)) f (by + intro z hz + change f z ∈ LinearMap.ker (f ^ n) + rw [LinearMap.mem_ker] at hz ⊢ + rw [← Module.End.mul_apply, (Commute.self_pow f n).eq.symm, + Module.End.mul_apply, hz, f.map_zero])) := by + rw [← LinearMap.ker_eq_bot, Submodule.ker_mapQ] + have hcomap : + (LinearMap.ker (f ^ n)).comap f = LinearMap.ker (f ^ n) := by + ext z + rw [Submodule.mem_comap] + change (f ^ n) (f z) = 0 ↔ (f ^ n) z = 0 + rw [← Module.End.mul_apply, (Commute.self_pow f n).eq.symm, + Module.End.mul_apply] + simpa [Module.End.pow_apply, Function.iterate_succ_apply'] using + congrArg (fun K : Submodule R E ↦ z ∈ K) hstable.symm + rw [hcomap] + simp + +/-- Removing a finite-length invariant submodule on which all failure of +injectivity is concentrated preserves the principal Koszul Euler length. +The hypothesis `T.comap f = T` says precisely that the quotient action is +injective; it does not assert injectivity on the original module. -/ +theorem length_cokernel_eq_kernel_add_regular_quotient + (f : Module.End R E) (T : Submodule R E) + [IsNoetherian R T] [IsArtinian R T] (hT : T.comap f = T) : + Module.length R (E ⧸ f.range) = + Module.length R f.ker + Module.length R (E ⧸ (T ⊔ f.range)) := by + have hstable : ∀ z ∈ T, f z ∈ T := by + intro z hz + exact show z ∈ T.comap f from hT.symm ▸ hz + let fT : Module.End R T := f.restrict hstable + have hpre : f.range.comap T.subtype = fT.range := by + ext z + constructor + · rintro ⟨w, hw⟩ + have hwT : w ∈ T := by + rw [← hT] + exact show f w ∈ T from hw ▸ z.property + exact ⟨⟨w, hwT⟩, Subtype.ext hw⟩ + · rintro ⟨w, rfl⟩ + exact ⟨w.val, rfl⟩ + let i : (T ⧸ fT.range) →ₗ[R] (E ⧸ f.range) := + fT.range.mapQ f.range T.subtype hpre.ge + let j : (E ⧸ f.range) →ₗ[R] (E ⧸ (T ⊔ f.range)) := + f.range.mapQ (T ⊔ f.range) LinearMap.id le_sup_right + have hi : Function.Injective i := by + rw [← LinearMap.ker_eq_bot] + dsimp [i] + rw [Submodule.ker_mapQ, hpre, Submodule.mkQ_map_self] + have hj : Function.Surjective j := by + rw [← LinearMap.range_eq_top] + simp [j, Submodule.range_mapQ] + have hexact : Function.Exact i j := by + rw [LinearMap.exact_iff] + simp [i, j, Submodule.range_mapQ, Submodule.ker_mapQ, + Submodule.map_sup, Submodule.mkQ_map_self] + have hsum := Module.length_eq_add_of_exact i j hi hj hexact + have hkerle : f.ker ≤ T := by + intro z hz + rw [← hT] + change f z ∈ T + rw [LinearMap.mem_ker.mp hz] + exact T.zero_mem + have hker : Module.length R fT.ker = Module.length R f.ker := by + have hk : fT.ker = f.ker.comap T.subtype := by + simp [fT, LinearMap.ker_restrict] + rw [hk] + exact (Submodule.comapSubtypeEquivOfLe hkerle).length_eq + have hsource := Module.length_eq_add_of_exact fT.ker.subtype fT.rangeRestrict + (Submodule.subtype_injective _) + (LinearMap.range_eq_top.mp (LinearMap.range_rangeRestrict fT)) + (by rw [LinearMap.exact_iff, Submodule.range_subtype, LinearMap.ker_rangeRestrict]) + have htarget := Module.length_eq_add_of_exact fT.range.subtype fT.range.mkQ + (Submodule.subtype_injective _) (Submodule.mkQ_surjective _) + (LinearMap.exact_subtype_mkQ _) + have hcancel : Module.length R (T ⧸ fT.range) = Module.length R fT.ker := by + have hfinite : Module.length R fT.range ≠ ⊤ := Module.length_ne_top + apply ENat.add_left_injective_of_ne_top hfinite + change Module.length R (T ⧸ fT.range) + Module.length R fT.range = + Module.length R fT.ker + Module.length R fT.range + rw [add_comm (Module.length R (T ⧸ fT.range)), ← htarget] + exact hsource + rw [hcancel, hker] at hsum + exact hsum + +/-- A maximal-ideal scalar has a proper image on a nonzero finite module. -/ +theorem scalar_range_ne_top_of_mem_maximalIdeal + [IsLocalRing R] [Module.Finite R E] [Nontrivial E] + {x : R} (hx : x ∈ IsLocalRing.maximalIdeal R) : + (scalarEnd (E := E) x).range ≠ (⊤ : Submodule R E) := by + have hann : Module.annihilator R E ≠ ⊤ := by + intro h + exact not_subsingleton_iff_nontrivial.mpr inferInstance + (Module.annihilator_eq_top_iff.mp h) + have hspan : Ideal.span ({x} : Set R) ≤ + (Module.annihilator R E).jacobson := by + rw [Ideal.span_singleton_le_iff_mem] + rw [IsLocalRing.jacobson_eq_maximalIdeal _ hann] + exact hx + have hsmul : (⊤ : Submodule R E) ≠ Ideal.span ({x} : Set R) • (⊤ : Submodule R E) := + Submodule.top_ne_ideal_smul_of_le_jacobson_annihilator hspan + intro hrange + apply hsmul + have hEq : (scalarEnd (E := E) x).range = + Ideal.span ({x} : Set R) • (⊤ : Submodule R E) := by + ext y + constructor + · rintro ⟨z, rfl⟩ + exact Submodule.smul_mem_smul (Submodule.subset_span (Set.mem_singleton x)) + (Submodule.mem_top) + · intro hy + refine Submodule.smul_induction_on hy ?_ (fun a b ha hb => ?_) + · intro r hr z hz + rcases (Ideal.mem_span_singleton.mp hr) with ⟨c, rfl⟩ + refine ⟨c • z, ?_⟩ + simp [scalarEnd, smul_smul, mul_comm] + · exact add_mem (by assumption) (by assumption) + exact hrange.symm.trans hEq + +/-- +If multiplication by `x` is injective on a nonzero finite local module and +its cokernel has finite length, then the cokernel has strictly larger length +than the kernel. The quotient is nonzero by Nakayama, so the conclusion is +genuine positivity rather than an axiom-shaped length assumption. + +This is only the regular (torsion-free) specialization of the stabilized +`x`-power-torsion cancellation argument. Minimal-support avoidance alone +does not imply its injectivity hypothesis when embedded torsion is present. +-/ +theorem length_cokernel_smul_gt_length_kernel_smul + [IsLocalRing R] [Module.Finite R E] [Nontrivial E] {x : R} + (hx : x ∈ IsLocalRing.maximalIdeal R) + (hinj : Function.Injective (scalarEnd (E := E) x)) + (_hfinite : IsFiniteLength R (E ⧸ (scalarEnd (E := E) x).range)) : + Module.length R (E ⧸ (scalarEnd (E := E) x).range) > + Module.length R (scalarEnd (E := E) x).ker := by + have hker : (scalarEnd (E := E) x).ker = ⊥ := by + apply le_antisymm + · intro y hy + apply hinj + simpa using (LinearMap.mem_ker.mp hy) + · exact bot_le + have hq : Nontrivial (E ⧸ (scalarEnd (E := E) x).range) := + Submodule.Quotient.nontrivial_iff.mpr + (scalar_range_ne_top_of_mem_maximalIdeal hx) + rw [hker, Module.length_bot] + exact Module.length_pos + +/-- Embedded scalar-power torsion may be retained: after its finite-length +Euler contribution is cancelled, any nonzero regular quotient contributes +strictly positively by Nakayama. -/ +theorem length_cokernel_smul_gt_kernel_of_finite_torsion + [IsLocalRing R] [Module.Finite R E] + {x : R} (hx : x ∈ IsLocalRing.maximalIdeal R) + (T : Submodule R E) [IsNoetherian R T] [IsArtinian R T] + (hT : T.comap (scalarEnd (E := E) x) = T) (hproper : T ≠ ⊤) : + Module.length R (E ⧸ (scalarEnd (E := E) x).range) > + Module.length R (scalarEnd (E := E) x).ker := by + let f := scalarEnd (E := E) x + have hstable : T ≤ T.comap f := hT.ge + let g : Module.End R (E ⧸ T) := T.mapQ T f hstable + have hg : g = scalarEnd (E := E ⧸ T) x := by + ext z + rfl + have hrange : g.range = f.range.map T.mkQ := Submodule.range_mapQ _ _ _ _ + let : Nontrivial (E ⧸ T) := Submodule.Quotient.nontrivial_iff.mpr hproper + have hnontop : f.range.map T.mkQ ≠ ⊤ := by + rw [← hrange, hg] + exact scalar_range_ne_top_of_mem_maximalIdeal hx + let : Nontrivial ((E ⧸ T) ⧸ f.range.map T.mkQ) := + Submodule.Quotient.nontrivial_iff.mpr hnontop + have hpositive : 0 < Module.length R (E ⧸ (T ⊔ f.range)) := by + rw [← (Submodule.quotientQuotientEquivQuotientSup T f.range).length_eq] + exact Module.length_pos + have hkerle : f.ker ≤ T := by + intro z hz + rw [← hT] + change f z ∈ T + rw [LinearMap.mem_ker.mp hz] + exact T.zero_mem + let : IsNoetherian R f.ker := + isNoetherian_of_injective (Submodule.inclusion hkerle) + (Submodule.inclusion_injective hkerle) + let : IsArtinian R f.ker := + isArtinian_of_injective (Submodule.inclusion hkerle) + (Submodule.inclusion_injective hkerle) + rw [length_cokernel_eq_kernel_add_regular_quotient f T hT] + simpa [add_comm] using ENat.lt_add_left (Module.length_ne_top (R := R) (M := f.ker)) hpositive + +/-- Principal Koszul positivity, including embedded torsion. A support prime +not containing `x` guarantees a nonzero regular quotient; finite length of +the coordinate kernel makes the discarded power torsion finite length. -/ +theorem length_cokernel_smul_gt_kernel_of_support_prime + [IsLocalRing R] [Module.Finite R E] [IsNoetherian R E] + {x : R} (hx : x ∈ IsLocalRing.maximalIdeal R) + [IsArtinian R (scalarEnd (E := E) x).ker] + (P : Ideal R) (hP : P.IsPrime) + (hann : Module.annihilator R E ≤ P) (hxP : x ∉ P) : + Module.length R (E ⧸ (scalarEnd (E := E) x).range) > + Module.length R (scalarEnd (E := E) x).ker := by + let f := scalarEnd (E := E) x + obtain ⟨n, hn⟩ := exists_stable_kernel_power f + let T := (f ^ n).ker + let : IsArtinian R T := isArtinian_kernel_power f n + have hcomap : T.comap f = T := by + ext z + rw [Submodule.mem_comap] + change (f ^ n) (f z) = 0 ↔ (f ^ n) z = 0 + rw [← Module.End.mul_apply, (Commute.self_pow f n).eq.symm, + Module.End.mul_apply] + simpa [Module.End.pow_apply, Function.iterate_succ_apply'] using + congrArg (fun K : Submodule R E ↦ z ∈ K) hn.symm + have hpower : ∀ m (z : E), (f ^ m) z = x ^ m • z := by + intro m + induction m with + | zero => intro z; simp + | succ m ih => + intro z + simp [pow_succ, Module.End.mul_apply, ih, f, scalarEnd, smul_smul] + have hproper : T ≠ ⊤ := by + intro htop + apply hxP + apply hP.mem_of_pow_mem n + apply hann + rw [Module.mem_annihilator] + intro z + rw [← hpower n z] + exact LinearMap.mem_ker.mp (show z ∈ T by rw [htop]; trivial) + exact length_cokernel_smul_gt_kernel_of_finite_torsion hx T hcomap hproper + + +end +end AlgebraicAnalysis.PrincipalKoszulPositivity diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/PrincipalKoszulSupportOverBase.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/PrincipalKoszulSupportOverBase.lean new file mode 100644 index 0000000000..58a8893f22 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/PrincipalKoszulSupportOverBase.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.StableTorsionResidualSupport +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulFiniteTorsion + + +/-! +# Principal Koszul positivity after restriction of scalars + +Support and torsion are computed over the coefficient algebra `C`; the +resulting length inequality is measured over the base ring `R`. No finite +generation of `E` over `R` is needed: only the first `R`-kernel has finite +length. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.PrincipalKoszulSupportOverBase + +open AlgebraicAnalysis.PrincipalKoszulPositivity +open AlgebraicAnalysis.PrincipalKoszulFiniteTorsion +open AlgebraicAnalysis.StableTorsionResidualSupport + +noncomputable section + +universe u v w + +variable {R : Type u} {C : Type v} {E : Type w} +variable [CommRing R] [CommRing C] [Algebra R C] +variable [AddCommGroup E] [Module C E] [Module R E] +variable [IsScalarTower R C E] + +theorem length_cokernel_gt_kernel_of_support_over_base + [IsNoetherianRing C] [Module.Finite C E] + (x : C) (p q : PrimeSpectrum C) + (hp : p ∈ Module.support C E) (hpq : p ≤ q) + (hxp : x ∉ p.asIdeal) + (hq : q ∈ Module.support C (QuotSMulTop x E)) + (hfinite : IsFiniteLength R + (LinearMap.ker ((LinearMap.lsmul C E x).restrictScalars R))) : + Module.length R (E ⧸ LinearMap.range ((LinearMap.lsmul C E x).restrictScalars R)) > + Module.length R (LinearMap.ker ((LinearMap.lsmul C E x).restrictScalars R)) := by + let fC : Module.End C E := LinearMap.lsmul C E x + let fR : Module.End R E := fC.restrictScalars R + obtain ⟨n, hn⟩ := exists_stable_kernel_power_smul (E := E) x + have hpow : ∀ m, fR ^ m = (fC ^ m).restrictScalars R := by + intro m + induction m with + | zero => ext z; simp + | succ m ih => + rw [pow_succ, pow_succ, ih] + ext z + simp [fR, LinearMap.restrictScalars_apply, Module.End.mul_apply] + have hstable : LinearMap.ker (fR ^ n) = LinearMap.ker (fR ^ (n + 1)) := by + rw [hpow, hpow, LinearMap.ker_restrictScalars, LinearMap.ker_restrictScalars] + exact congrArg (Submodule.restrictScalars R) hn + have hnonzeroC : Nontrivial (E ⧸ (LinearMap.ker (fC ^ n) ⊔ fC.range)) := + residual_nontrivial_of_support x n p q hp hpq hxp hq + let PC : Submodule C E := LinearMap.ker (fC ^ n) ⊔ fC.range + let PR : Submodule R E := LinearMap.ker (fR ^ n) ⊔ fR.range + have hPR : PR = PC.restrictScalars R := by + dsimp [PR, PC] + rw [show fR ^ n = (fC ^ n).restrictScalars R from hpow n] + simp only [LinearMap.ker_restrictScalars, Submodule.restrictScalars_sup] + rfl + have hnonzeroR : Nontrivial (E ⧸ PR) := by + have hPC : PC ≠ (⊤ : Submodule C E) := + Submodule.Quotient.nontrivial_iff.mp hnonzeroC + apply Submodule.Quotient.nontrivial_iff.mpr + intro htop + apply hPC + apply (Submodule.restrictScalars_eq_top_iff R C E).mp + rw [← hPR, htop] + have hresult := + length_cokernel_gt_kernel_of_stable_power_and_nonzero + (R := R) fR n hfinite hstable hnonzeroR + simpa [fR, fC] using hresult + + +end +end AlgebraicAnalysis.PrincipalKoszulSupportOverBase diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/RankExact.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/RankExact.lean new file mode 100644 index 0000000000..1807b83e89 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/RankExact.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.RankTorsion +public import Mathlib.LinearAlgebra.Dimension.DivisionRing + + +/-! +# Rank additivity for split sequences + +Packet 2 cannot currently assert that noncommutative Ore localization is flat: +the pinned Mathlib has no such theorem. This file therefore proves the exact +additivity statements that require only an explicit linear equivalence after +localization. In particular, whenever a localized short exact sequence is +known to split, its localized middle term is equivalent to a product and the +rank is additive. No flatness or exactness interface is postulated here. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis +namespace RankExact + +open OreLocalization +open nonZeroDivisors + +universe u v + +section DivisionRing + +variable {Q : Type u} [DivisionRing Q] +variable {V W : Type v} [AddCommGroup V] [Module Q V] +variable [AddCommGroup W] [Module Q W] + +theorem rank_prod_add : + Module.rank Q (V × W) = Module.rank Q V + Module.rank Q W := by + exact rank_prod' + +theorem rank_add_of_linearEquiv_prod {U : Type v} + [AddCommGroup U] [Module Q U] + (e : U ≃ₗ[Q] V × W) : + Module.rank Q U = Module.rank Q V + Module.rank Q W := by + rw [e.rank_eq, rank_prod_add] + +theorem rank_add_of_split_exact + {U : Type v} [AddCommGroup U] [Module Q U] + (i : V →ₗ[Q] U) (p : U →ₗ[Q] W) + (r : U →ₗ[Q] V) (s : W →ₗ[Q] U) + (hri : r.comp i = LinearMap.id) + (hps : p.comp s = LinearMap.id) + (hpi : p.comp i = 0) + (hrs : r.comp s = 0) + (hdecomp : i.comp r + s.comp p = LinearMap.id) : + Module.rank Q U = Module.rank Q V + Module.rank Q W := by + let f : U →ₗ[Q] V × W := LinearMap.prod r p + let g : V × W →ₗ[Q] U := LinearMap.coprod i s + have hgf : g.comp f = LinearMap.id := by + ext u + change i (r u) + s (p u) = u + exact LinearMap.congr_fun hdecomp u + have hfg : f.comp g = LinearMap.id := by + apply LinearMap.ext + intro z + rcases z with ⟨v, w⟩ + apply Prod.ext + · change r (i v + s w) = v + rw [map_add] + have hri' : r (i v) = v := by + simpa only [LinearMap.comp_apply, LinearMap.id_apply] using + LinearMap.congr_fun hri v + have hrs' : r (s w) = 0 := by + simpa only [LinearMap.comp_apply, LinearMap.zero_apply] using + LinearMap.congr_fun hrs w + rw [hri', hrs', add_zero] + · change p (i v + s w) = w + rw [map_add] + have hpi' : p (i v) = 0 := by + simpa only [LinearMap.comp_apply, LinearMap.zero_apply] using + LinearMap.congr_fun hpi v + have hps' : p (s w) = w := by + simpa only [LinearMap.comp_apply, LinearMap.id_apply] using + LinearMap.congr_fun hps w + rw [hpi', hps', zero_add] + have hf : Function.Bijective f := by + constructor + · intro u₁ u₂ h + have hgfu (u : U) : g (f u) = u := by + simpa only [LinearMap.comp_apply, LinearMap.id_apply] using + LinearMap.congr_fun hgf u + calc + u₁ = g (f u₁) := (hgfu u₁).symm + _ = g (f u₂) := congrArg g h + _ = u₂ := hgfu u₂ + · intro z + have hfgz (z : V × W) : f (g z) = z := by + simpa only [LinearMap.comp_apply, LinearMap.id_apply] using + LinearMap.congr_fun hfg z + exact ⟨g z, hfgz z⟩ + exact rank_add_of_linearEquiv_prod (LinearEquiv.ofBijective f hf) + +theorem finrank_prod_add [Module.Finite Q V] [Module.Finite Q W] : + Module.finrank Q (V × W) = Module.finrank Q V + Module.finrank Q W := by + exact Module.finrank_prod +theorem finrank_add_of_linearEquiv_prod {U : Type v} + [AddCommGroup U] [Module Q U] + [Module.Finite Q V] [Module.Finite Q W] + (e : U ≃ₗ[Q] V × W) : + Module.finrank Q U = Module.finrank Q V + Module.finrank Q W := by + rw [e.finrank_eq, finrank_prod_add] + +end DivisionRing + +section LocalizedOre + +variable {R : Type u} [Ring R] [Nontrivial R] [NoZeroDivisors R] +variable [OreLocalization.OreSet (Rᵐᵒᵖ)⁰] +variable {M N P : Type v} +variable [AddCommGroup M] [Module Rᵐᵒᵖ M] +variable [AddCommGroup N] [Module Rᵐᵒᵖ N] +variable [AddCommGroup P] [Module Rᵐᵒᵖ P] + +open AlgebraicAnalysis.RankTorsion + +theorem oreRank_add_of_localized_prod_equiv + (e : LocalizedRightModule R M ≃ₗ[FractionRingOp R] + (LocalizedRightModule R N × LocalizedRightModule R P)) : + oreRank (R := R) M = oreRank (R := R) N + oreRank (R := R) P := by + rw [oreRank_eq_rank_localized, e.rank_eq, rank_prod_add, + oreRank_eq_rank_localized, oreRank_eq_rank_localized] + +end LocalizedOre + + +end RankExact +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/RankTorsion.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/RankTorsion.lean new file mode 100644 index 0000000000..a744150ba8 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/RankTorsion.lean @@ -0,0 +1,195 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.OreLocalization.Ring +public import Mathlib.LinearAlgebra.Dimension.DivisionRing +public import Mathlib.LinearAlgebra.Dimension.Torsion.Finite + + +/-! +# Rank and torsion over Ore localizations + +This file contains the part of handover packet 2 which is available without +postulating a noncommutative flatness theorem. A right `R`-module is encoded +as a left `Rᵐᵒᵖ`-module. When the right Ore condition needed for this +localization holds, its Ore localization is a module over the division ring +of fractions of `Rᵐᵒᵖ`; `oreRank` is the ordinary vector-space rank of that +localization. + +The pinned Mathlib has the Ore localization and its division-ring structure, +but not the noncommutative tensor/localization exactness theorem (the +commutative tensor-product exactness file explicitly lists this as TODO). +Consequently this file proves the rank-nullity and torsion criteria for the +localized division-ring module, and records the exact first missing bridge: +that localization sends an arbitrary short exact sequence of right +`R`-modules to a short exact sequence. No proposition in this file assumes +that bridge or introduces an axiom for it. + +The commutative-domain criterion `rank_eq_zero_iff_isTorsion` imported from +Mathlib remains available, but is deliberately not reused as a theorem about +noncommutative `R`. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis +namespace RankTorsion + +open nonZeroDivisors +open OreLocalization + +universe u v + +section DivisionRingRank + +variable {Q : Type u} [DivisionRing Q] +variable {V V' : Type v} [AddCommGroup V] [Module Q V] +variable [AddCommGroup V'] [Module Q V'] + +/-! ## Unconditional vector-space rank facts -/ + +theorem rank_quotient_add_rank (P : Submodule Q V) : + Module.rank Q (V ⧸ P) + Module.rank Q P = Module.rank Q V := + rank_quotient_add_rank_of_divisionRing P + +theorem rank_eq_zero_iff_subsingleton : + Module.rank Q V = 0 ↔ Subsingleton V := by + exact rank_zero_iff + +theorem rank_eq_zero_iff_forall_zero : + Module.rank Q V = 0 ↔ ∀ v : V, v = 0 := by + constructor + · intro h v + let : Subsingleton V := (rank_zero_iff.mp h) + exact Subsingleton.elim v 0 + · intro h + apply rank_zero_iff.mpr + exact ⟨fun x y => (h x).trans (h y).symm⟩ + +theorem rank_eq_zero_iff_isTorsionOverDivisionRing : + Module.rank Q V = 0 ↔ + (∀ v : V, ∃ a : Q, a ≠ 0 ∧ a • v = 0) := by + exact rank_eq_zero_iff + +theorem finrank_quotient_add_finrank [Module.Finite Q V] (P : Submodule Q V) : + Module.finrank Q (V ⧸ P) + Module.finrank Q P = Module.finrank Q V := + P.finrank_quotient_add_finrank + +theorem rank_eq_of_surjective (f : V →ₗ[Q] V') (hf : Function.Surjective f) : + Module.rank Q V = Module.rank Q V' + Module.rank Q (LinearMap.ker f) := + LinearMap.rank_eq_of_surjective hf +theorem finrank_eq_of_surjective [Module.Finite Q V] + (f : V →ₗ[Q] V') (hf : Function.Surjective f) : + Module.finrank Q V = Module.finrank Q V' + + Module.finrank Q (LinearMap.ker f) := by + have h := (LinearMap.ker f).finrank_quotient_add_finrank + rw [LinearEquiv.finrank_eq (LinearMap.quotKerEquivOfSurjective f hf)] at h + exact h.symm + +end DivisionRingRank + +section OreLocalizedRightModules + +/-! +`OreSet R⁰` is the left Ore condition. A right module is localized using the +opposite ring, so the corresponding right Ore condition is represented by an +explicit `OreSet (Rᵐᵒᵖ)⁰` assumption. This is intentional: left Ore alone does +not imply right Ore for a general domain. +-/ + +variable {R : Type u} [Ring R] [Nontrivial R] [NoZeroDivisors R] +variable [OreLocalization.OreSet (Rᵐᵒᵖ)⁰] +variable {M : Type v} [AddCommGroup M] [Module Rᵐᵒᵖ M] + +/-- The full Ore localization of the opposite coefficient ring. -/ +abbrev FractionRingOp (R : Type u) [Ring R] + [OreLocalization.OreSet (Rᵐᵒᵖ)⁰] := + (Rᵐᵒᵖ)[(Rᵐᵒᵖ)⁰⁻¹] + +/-- Localization of a right `R`-module, represented as a left opposite-module. -/ +abbrev LocalizedRightModule (R : Type u) (M : Type v) + [Ring R] + [OreLocalization.OreSet (Rᵐᵒᵖ)⁰] [AddCommGroup M] [Module Rᵐᵒᵖ M] := + M[(Rᵐᵒᵖ)⁰⁻¹] + +/-- The rank of a right module after passage to the full fraction ring. -/ +noncomputable def oreRank (M : Type v) [AddCommGroup M] [Module Rᵐᵒᵖ M] : Cardinal := + Module.rank (FractionRingOp R) (LocalizedRightModule R M) +omit [Nontrivial R] [NoZeroDivisors R] in +theorem oreRank_eq_rank_localized : + oreRank (R := R) M = + Module.rank (FractionRingOp R) (LocalizedRightModule R M) := + rfl +omit [Nontrivial R] [NoZeroDivisors R] in +theorem oreRank_eq_of_localizedLinearEquiv {N : Type v} + [AddCommGroup N] [Module Rᵐᵒᵖ N] + (e : LocalizedRightModule R M ≃ₗ[FractionRingOp R] + LocalizedRightModule R N) : + oreRank (R := R) M = oreRank (R := R) N := by + exact e.rank_eq +omit [Nontrivial R] [NoZeroDivisors R] in +theorem localized_oreDiv_one_eq_zero_iff (m : M) : + (m /ₒ (1 : (Rᵐᵒᵖ)⁰) : LocalizedRightModule R M) = 0 ↔ + ∃ s : (Rᵐᵒᵖ)⁰, s • m = 0 := by + constructor + · intro h + rw [← OreLocalization.zero_oreDiv (1 : (Rᵐᵒᵖ)⁰)] at h + rw [OreLocalization.oreDiv_eq_iff] at h + rcases h with ⟨u, v, huv, hden⟩ + have hv : v = (u : Rᵐᵒᵖ) := by simpa using hden.symm + refine ⟨u, ?_⟩ + change (u : Rᵐᵒᵖ) • m = 0 + rw [← hv] + simpa using huv.symm + · rintro ⟨s, hs⟩ + change (s : Rᵐᵒᵖ) • m = 0 at hs + rw [← OreLocalization.zero_oreDiv (1 : (Rᵐᵒᵖ)⁰)] + rw [OreLocalization.oreDiv_eq_iff] + refine ⟨s, (s : Rᵐᵒᵖ), ?_, ?_⟩ + · simpa using hs.symm + · simp + +theorem oreRank_zero_iff_localized_subsingleton : + oreRank (R := R) M = 0 ↔ Subsingleton (LocalizedRightModule R M) := by + exact rank_zero_iff + +theorem oreRank_zero_iff_rightTorsion : + oreRank (R := R) M = 0 ↔ + (∀ m : M, ∃ s : (Rᵐᵒᵖ)⁰, s • m = 0) := by + rw [oreRank_zero_iff_localized_subsingleton] + constructor + · intro h m + have hz : (m /ₒ (1 : (Rᵐᵒᵖ)⁰) : LocalizedRightModule R M) = 0 := by + exact Subsingleton.elim _ _ + exact (localized_oreDiv_one_eq_zero_iff m).mp hz + · intro h + refine ⟨fun x y => ?_⟩ + have hzero : ∀ z : LocalizedRightModule R M, z = 0 := by + intro z + induction z using OreLocalization.ind with + | _ m s => + rw [← OreLocalization.zero_oreDiv (s : (Rᵐᵒᵖ)⁰)] + obtain ⟨t, ht⟩ := h m + change (t : Rᵐᵒᵖ) • m = 0 at ht + rw [OreLocalization.oreDiv_eq_iff] + refine ⟨t, (t : Rᵐᵒᵖ), ?_, ?_⟩ + · simpa using ht.symm + · simp + exact (hzero x).trans (hzero y).symm + +theorem oreRank_zero_iff_localized_torsion : + oreRank (R := R) M = 0 ↔ + (∀ z : LocalizedRightModule R M, + ∃ a : FractionRingOp R, a ≠ 0 ∧ a • z = 0) := by + exact rank_eq_zero_iff_isTorsionOverDivisionRing + + +end OreLocalizedRightModules + +end RankTorsion +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/RightCoordinates.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/RightCoordinates.lean new file mode 100644 index 0000000000..6e78d975b8 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/RightCoordinates.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Module.Submodule.Basic +public import Mathlib.Algebra.Module.Submodule.Lattice +public import Mathlib.Data.Finsupp.Pointwise +public import Mathlib.Data.Finsupp.SMul +public import Mathlib.Tactic + + +/-! +# The concrete right-coordinate model for a stage + +The iterated Ore tower currently supplies nested additive normal forms, but it +does not yet identify a localized stage with a free right module over its +coefficient stage. This file formalizes the part that is unconditional and +used once that identification is available: the canonical coordinatewise +right action on the free coordinate object `ι →₀ S`, together with its finite +single-coordinate decomposition. No freeness of an Ore localization is +assumed or encoded by an equivalent hypothesis here. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.RightCoordinates + +noncomputable section + +variable {S ι α : Type*} [Ring S] + +/-- The coordinatewise right action on finitely supported `S`-coordinates. -/ +def rightCoordinateAction (v : ι →₀ S) (a : S) : ι →₀ S := + (MulOpposite.op a : Sᵐᵒᵖ) • v + +@[simp] +theorem rightCoordinateAction_apply (v : ι →₀ S) (a : S) (i : ι) : + rightCoordinateAction v a i = v i * a := rfl + +@[simp] +theorem rightCoordinateAction_eq_op_smul (v : ι →₀ S) (a : S) : + rightCoordinateAction v a = + (MulOpposite.op a : Sᵐᵒᵖ) • v := rfl + +/-- Coordinatewise right multiplication is additive in the vector. -/ +theorem rightCoordinateAction_add (v w : ι →₀ S) (a : S) : + rightCoordinateAction (v + w) a = + rightCoordinateAction v a + rightCoordinateAction w a := by + ext i + simp [rightCoordinateAction] + +/-- Coordinatewise right multiplication is additive in the scalar. -/ +theorem rightCoordinateAction_add_scalar (v : ι →₀ S) (a b : S) : + rightCoordinateAction v (a + b) = + rightCoordinateAction v a + rightCoordinateAction v b := by + ext i + simp [rightCoordinateAction, mul_add] + +theorem rightCoordinateAction_one (v : ι →₀ S) : + rightCoordinateAction v 1 = v := by + simp only [rightCoordinateAction_eq_op_smul, MulOpposite.op_one, one_smul] + +/-- Written in right-sided order, successive coordinate actions multiply the +scalars in the same order. -/ +theorem rightCoordinateAction_mul (v : ι →₀ S) (a b : S) : + rightCoordinateAction (rightCoordinateAction v a) b = + rightCoordinateAction v (a * b) := by + ext i + simp [rightCoordinateAction, mul_assoc] + +/-- Coordinatewise right multiplication commutes with finite additive sums. -/ +theorem rightCoordinateAction_sum (t : Finset α) (f : α → ι →₀ S) (a : S) : + rightCoordinateAction (∑ j ∈ t, f j) a = + ∑ j ∈ t, rightCoordinateAction (f j) a := by + ext i + simp [rightCoordinateAction, Finset.sum_mul] + +/-- A single coordinate remains a single coordinate under the right action. -/ +theorem rightCoordinateAction_single (i : ι) (s a : S) : + rightCoordinateAction (Finsupp.single i s) a = + Finsupp.single i (s * a) := by + ext j + by_cases h : i = j + · subst j + simp [rightCoordinateAction] + · simp [rightCoordinateAction, Ne.symm h] + +/-- Every finitely supported coordinate vector is the finite sum of its pure +coordinate vectors. -/ +theorem rightCoordinate_decomposition (v : ι →₀ S) : + v = ∑ i ∈ v.support, Finsupp.single i (v i) := by + symm + exact Finsupp.sum_single v + +/-- After a right action, the finite coordinate decomposition is acted on +coordinatewise. -/ +theorem rightCoordinate_decomposition_action (v : ι →₀ S) (a : S) : + rightCoordinateAction v a = + ∑ i ∈ v.support, Finsupp.single i (v i * a) := by + calc + rightCoordinateAction v a = + rightCoordinateAction + (∑ i ∈ v.support, Finsupp.single i (v i)) a := by + exact congrArg (fun w => rightCoordinateAction w a) + (rightCoordinate_decomposition v) + _ = ∑ i ∈ v.support, + rightCoordinateAction (Finsupp.single i (v i)) a := by + rw [rightCoordinateAction_sum] + _ = ∑ i ∈ v.support, Finsupp.single i (v i * a) := by + simp_rw [rightCoordinateAction_single] + +/-- The canonical pure coordinates generate the free right-coordinate model. -/ +theorem rightCoordinate_eq_top_of_single_mem + (H : Submodule Sᵐᵒᵖ (ι →₀ S)) + (hH : ∀ i : ι, ∀ s : S, Finsupp.single i s ∈ H) : + H = ⊤ := by + apply top_unique + intro v hv + rw [rightCoordinate_decomposition v] + apply Submodule.sum_mem + intro i hi + exact hH i (v i) + + +end +end AlgebraicAnalysis.RightCoordinates diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/Splice.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/Splice.lean new file mode 100644 index 0000000000..ba88379460 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/Splice.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.SimpleModule.Basic +public import Mathlib.Tactic + + +/-! +# Maximal-submodule splice + +These are lattice-theoretic module lemmas used by finite-length correction +arguments. They contain no finite-length, Ore, or differential-operator +assumption. The hypotheses that construct the relevant submodules remain +with the application. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.Splice + +open Submodule + +variable {R M : Type*} [Ring R] [AddCommGroup M] [Module R M] + +/-- A simple layer turns a proper submodule whose sum with the layer is top +into a maximal submodule. -/ +theorem isCoatom_of_covBy_sup_eq_top + {N N' U : Submodule R M} + (hNU : N ≤ U) (hNN' : N ⋖ N') + (hsup : N' ⊔ U = ⊤) (hUtop : U ≠ ⊤) : + IsCoatom U := by + have hInfEq : N' ⊓ U = N := by + apply le_antisymm + · by_contra hnot + have hNInf : N ≤ N' ⊓ U := le_inf hNN'.le hNU + have hNe : N ≠ N' ⊓ U := by + intro hEq + apply hnot + rw [hEq] + rcases hNN'.eq_or_eq hNInf inf_le_left with hEq | hEq + · exact hnot (by rw [hEq]) + · have hN'leU : N' ≤ U := by + rw [← hEq] + exact inf_le_right + apply hUtop + calc + U = N' ⊔ U := (sup_eq_right.mpr hN'leU).symm + _ = ⊤ := hsup + · exact le_inf hNN'.le hNU + have hInfCov : U ⊓ N' ⋖ N' := by + simpa [inf_comm, hInfEq] using hNN' + have hCov : U ⋖ U ⊔ N' := covBy_sup_of_inf_covBy_right hInfCov + have hCov' : U ⋖ ⊤ := by + simpa [sup_comm, hsup] using hCov + exact hCov'.isCoatom + +/-- A submodule containing both terms of a spanning pair is the whole module. -/ +theorem maximal_submodule_splice + {N' U H : Submodule R M} + (hsupU : N' ⊔ U = ⊤) (hUH : U ≤ H) (hN'H : N' ≤ H) : + H = ⊤ := by + apply top_unique + rw [← hsupU] + exact sup_le hN'H hUH + +/-- +If `v` lies in `P` and some scalar multiple of a vector escapes `P`, then the +class of the corresponding affine correction generates the simple quotient. +-/ +theorem exists_affine_correction_mod_simple_quotient + {P : Submodule R M} (v : M) (hv : v ∈ P) + (hsimple : IsSimpleModule R (M ⧸ P)) (alpha : R) + (hescape : ∃ delta : M, alpha • delta ∉ P) : + ∃ delta : M, span R {P.mkQ (v - alpha • delta)} = ⊤ := by + obtain ⟨delta, hdelta⟩ := hescape + have hne : P.mkQ (v - alpha • delta) ≠ 0 := by + rw [Ne, Submodule.mkQ_apply, Submodule.Quotient.mk_eq_zero] + intro hmem + apply hdelta + have hsub := P.sub_mem hv hmem + simpa [sub_sub_cancel] using hsub + refine ⟨delta, ?_⟩ + rw [LinearMap.span_singleton_eq_range, LinearMap.range_eq_top] + exact IsSimpleModule.toSpanSingleton_surjective R hne + + +end AlgebraicAnalysis.Splice diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/SplitLatticePresentation.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/SplitLatticePresentation.lean new file mode 100644 index 0000000000..2b8928fa1d --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/SplitLatticePresentation.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.LocalRing.Module +public import Mathlib.LinearAlgebra.Matrix.Basis + + +/-! +# Matrix coordinates for a finite-rank direct summand + +This file contains the coordinate-free-to-matrix step used by the general +tangent-limit criterion. A complemented submodule of a finite coordinate +module over a local ring is finite projective, hence finite free. Choosing a +basis only inside the proof produces a column matrix and a retraction matrix. +The matrices split, and their columns span exactly the original submodule. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.SplitLatticePresentation + +noncomputable section + +variable {R : Type*} [CommRing R] [IsLocalRing R] +variable {ι : Type*} [Fintype ι] [DecidableEq ι] + +/-- A matrix presentation constructed from a direct summand, with no chosen +basis or retraction in the input. -/ +structure SplitMatrixPresentation + (L : Submodule R (ι → R)) (r : ℕ) where + /-- Column matrix for the inclusion of the summand. -/ + B : Matrix ι (Fin r) R + /-- Retraction matrix for the chosen summand coordinates. -/ + C : Matrix (Fin r) ι R + leftInverse : C * B = 1 + columnsSpan : + Submodule.span R (Set.range fun j => fun i => B i j) = L + +omit [DecidableEq ι] in +/-- A finite-rank complemented submodule of a finite coordinate module over a +local ring has split matrix coordinates. Finiteness descends along the +projection onto the summand, projectivity comes from the split inclusion, and +finite flat modules over local rings are free. -/ +theorem exists_splitMatrixPresentation + (L L' : Submodule R (ι → R)) (hcompl : IsCompl L L') (r : ℕ) + (hrank : Module.finrank R L = r) : + Nonempty (SplitMatrixPresentation L r) := by + classical + let : DecidableEq ι := Classical.decEq ι + let p : (ι → R) →ₗ[R] L := L.projectionOnto L' hcompl + let : Module.Finite R L := + Module.Finite.of_surjective p (Submodule.projectionOnto_surjective hcompl) + let : Module.Projective R L := + Module.Projective.of_split L.subtype p + (Submodule.projectionOnto_comp_subtype hcompl) + let : Module.Flat R L := Module.Flat.of_projective + let : Module.Free R L := Module.free_of_flat_of_isLocalRing + let b : Module.Basis (Fin r) R L := + Module.finBasisOfFinrankEq R L hrank + let e : Module.Basis ι R (ι → R) := Pi.basisFun R ι + let B : Matrix ι (Fin r) R := LinearMap.toMatrix b e L.subtype + let C : Matrix (Fin r) ι R := LinearMap.toMatrix e b p + refine ⟨{ + B := B + C := C + leftInverse := ?_ + columnsSpan := ?_ }⟩ + · have hmatrix := LinearMap.toMatrix_comp b e b p L.subtype + rw [Submodule.projectionOnto_comp_subtype hcompl, + LinearMap.toMatrix_id] at hmatrix + simpa [B, C] using hmatrix.symm + · have hcolumns : + (fun j : Fin r => fun i => B i j) = + fun j => (b j : ι → R) := by + funext j i + simp [B, e, LinearMap.toMatrix_apply, Pi.basisFun_repr] + rw [hcolumns] + have himage : + L.subtype '' Set.range b = + Set.range (fun j => (b j : ι → R)) := by + ext x + simp only [Set.mem_image, Set.mem_range, Submodule.coe_subtype, + exists_exists_eq_and] + rw [← himage, ← Submodule.map_span, b.span_eq, Submodule.map_top] + exact Submodule.range_subtype (p := L) + +omit [DecidableEq ι] in +/-- Property-valued form: no particular complement is part of the input. -/ +theorem exists_splitMatrixPresentation_of_isComplemented + (L : Submodule R (ι → R)) (hcompl : IsComplemented L) (r : ℕ) + (hrank : Module.finrank R L = r) : + Nonempty (SplitMatrixPresentation L r) := by + classical + let : DecidableEq ι := Classical.decEq ι + obtain ⟨L', hLL'⟩ := hcompl + exact exists_splitMatrixPresentation L L' hLL' r hrank + + +end +end AlgebraicAnalysis.SplitLatticePresentation diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/StableTorsionResidualSupport.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/StableTorsionResidualSupport.lean new file mode 100644 index 0000000000..102674e255 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/StableTorsionResidualSupport.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.PrincipalKoszulPositivity +public import Mathlib.RingTheory.Support + + +/-! +# Support detects the residual after stable scalar torsion + +The support argument is most transparent before localization: the exact +sequence for the power kernel splits support into torsion and residual parts, +and `support_quotSMulTop` then applies at the larger prime. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.StableTorsionResidualSupport + +open scoped Pointwise + +noncomputable section + +universe u v + +variable {R : Type u} {E : Type v} +variable [CommRing R] [AddCommGroup E] [Module R E] + +/-- Scalar multiplication by `x`, viewed as a module endomorphism. -/ +abbrev scalarEnd (x : R) : E →ₗ[R] E := LinearMap.lsmul R E x + +theorem residual_nontrivial_of_support + [Module.Finite R E] + (x : R) (n : ℕ) (p q : PrimeSpectrum R) + (hp : p ∈ Module.support R E) (hpq : p ≤ q) + (hxp : x ∉ p.asIdeal) + (hq : q ∈ Module.support R (QuotSMulTop x E)) : + Nontrivial (E ⧸ (LinearMap.ker (scalarEnd (E := E) x ^ n) ⊔ + (scalarEnd (E := E) x).range)) := by + let f := scalarEnd (E := E) x + let T : Submodule R E := LinearMap.ker (f ^ n) + have hpower : ∀ m (z : E), (f ^ m) z = x ^ m • z := by + intro m + induction m with + | zero => intro z; simp + | succ m ih => + intro z + simp [pow_succ, Module.End.mul_apply, ih, f, scalarEnd, smul_smul] + have hTann : x ^ n ∈ Module.annihilator R T := by + rw [Module.mem_annihilator] + intro z + have hz := z.property + apply Subtype.ext + change x ^ n • (z : E) = 0 + change (f ^ n) (z : E) = 0 at hz + exact (hpower n (z : E)).symm.trans hz + have hpT : p ∉ Module.support R T := by + intro h + have hle := Module.annihilator_le_of_mem_support h + have hpow : x ^ n ∈ p.asIdeal := hle hTann + exact hxp (p.isPrime.mem_of_pow_mem n hpow) + have hexact : Function.Exact T.subtype T.mkQ := + LinearMap.exact_subtype_mkQ T + have hsupport : Module.support R E = + Module.support R T ∪ Module.support R (E ⧸ T) := + Module.support_of_exact hexact T.subtype_injective T.mkQ_surjective + have hpquot : p ∈ Module.support R (E ⧸ T) := by + have hpmem : p ∈ Module.support R T ∪ Module.support R (E ⧸ T) := by + rw [← hsupport] + exact hp + exact hpmem.resolve_left hpT + have hqquot : q ∈ Module.support R (E ⧸ T) := + Module.mem_support_mono hpq hpquot + have hqzero : q ∈ PrimeSpectrum.zeroLocus ({x} : Set R) := by + rw [Module.support_quotSMulTop (M := E) x] at hq + exact hq.2 + have hqres : q ∈ Module.support R (QuotSMulTop x (E ⧸ T)) := by + rw [Module.support_quotSMulTop] + exact ⟨hqquot, hqzero⟩ + have hglobal : Nontrivial (QuotSMulTop x (E ⧸ T)) := + Module.nonempty_support_iff.mp ⟨q, hqres⟩ + have hmap : Submodule.map T.mkQ (f.range) = + x • (⊤ : Submodule R (E ⧸ T)) := by + ext z + constructor + · rintro ⟨y, ⟨w, rfl⟩, rfl⟩ + simpa [f, scalarEnd] using + (Submodule.smul_mem_pointwise_smul (T.mkQ w) x (⊤ : Submodule R (E ⧸ T)) trivial) + · intro hz + have hz' : z ∈ Ideal.span ({x} : Set R) • (⊤ : Submodule R (E ⧸ T)) := by + rw [Submodule.ideal_span_singleton_smul] + exact hz + refine Submodule.smul_induction_on hz' ?_ (fun a b ha hb ↦ add_mem ha hb) + intro r hr z hz + rcases (Ideal.mem_span_singleton.mp hr) with ⟨c, rfl⟩ + refine Submodule.Quotient.induction_on T z ?_ + intro w + refine ⟨f (c • w), ⟨c • w, rfl⟩, ?_⟩ + simp [f, scalarEnd, smul_smul, mul_comm] + have hequiv : + ((E ⧸ T) ⧸ Submodule.map T.mkQ f.range) ≃ₗ[R] + E ⧸ (T ⊔ f.range) := + Submodule.quotientQuotientEquivQuotientSup T f.range + have hnontriv : Nontrivial ((E ⧸ T) ⧸ Submodule.map T.mkQ f.range) := by + rw [hmap] + exact Submodule.Quotient.nontrivial_iff.mpr (by + intro htop + exact not_subsingleton_iff_nontrivial.mpr hglobal + (Submodule.Quotient.subsingleton_iff.mpr htop)) + let : Nontrivial ((E ⧸ T) ⧸ Submodule.map T.mkQ f.range) := hnontriv + have hfinal := Equiv.nontrivial hequiv.symm.toEquiv + simpa [T, f] using hfinal + + +end +end AlgebraicAnalysis.StableTorsionResidualSupport diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/StablyFree.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/StablyFree.lean new file mode 100644 index 0000000000..9529f54660 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/StablyFree.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.Finiteness.Projective + + +/-! +# Stable freeness interface for projective modules + +This module records the application-independent right-module formulation of +stable freeness used in filtered-ring arguments. It is a definition, not a +claim that any particular ring has the property. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis +namespace StablyFree + +universe u + +/-- Every finitely generated projective right `R`-module becomes finite free +after adding a finite free summand. Right modules are represented as modules +over `Rᵐᵒᵖ`, so the order of scalar multiplication remains explicit. -/ +def StablyFreeProjectives (R : Type u) [Ring R] : Prop := + ∀ (P : Type u) [AddCommGroup P] [Module Rᵐᵒᵖ P], + Module.Projective Rᵐᵒᵖ P → Module.Finite Rᵐᵒᵖ P → + ∃ m n : ℕ, + Nonempty (P × (Fin m → Rᵐᵒᵖ) ≃ₗ[Rᵐᵒᵖ] (Fin n → Rᵐᵒᵖ)) + +end StablyFree +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/TorsionProjectiveImage.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/TorsionProjectiveImage.lean new file mode 100644 index 0000000000..dbd57b8aee --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/TorsionProjectiveImage.lean @@ -0,0 +1,89 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Module.FreeSummandInduction + + +/-! +# A projective-image terminal module lemma + +This file isolates the unconditional linear-algebra step in a torsion +presentation: a surjection from a product which kills its free factor factors +through the first factor. It does not assert that a torsion module admits +such a presentation. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.TorsionProjectiveImage + +variable {R P F T : Type*} [Ring R] +variable [AddCommGroup P] [Module R P] +variable [AddCommGroup F] [Module R F] +variable [AddCommGroup T] [Module R T] + +/-- A linear map out of a product which vanishes on the second factor is +already a map out of the first factor. -/ +theorem linearMap_product_factor_first + (q : P × F →ₗ[R] T) + (hkill : ∀ z : F, q (0, z) = 0) : + ∃ q₁ : P →ₗ[R] T, + q = q₁.comp (LinearMap.fst R P F) := by + let q₁ : P →ₗ[R] T := q.comp (LinearMap.inl R P F) + refine ⟨q₁, ?_⟩ + apply LinearMap.ext + rintro ⟨p, z⟩ + have hdecomp : (p, z) = (p, 0) + (0, z) := by + ext <;> simp + calc + q (p, z) = q ((p, 0) + (0, z)) := congrArg q hdecomp + _ = q (p, 0) + q (0, z) := q.map_add _ _ + _ = q (p, 0) := by rw [hkill, add_zero] + _ = q₁ p := rfl + _ = (q₁.comp (LinearMap.fst R P F)) (p, z) := rfl + +/-- Surjectivity also descends through the factorization in +`linearMap_product_factor_first`. -/ +theorem surjective_factor_first_of_surjective + (q : P × F →ₗ[R] T) + (hkill : ∀ z : F, q (0, z) = 0) + (hq : Function.Surjective q) : + ∃ q₁ : P →ₗ[R] T, Function.Surjective q₁ := by + obtain ⟨q₁, hfactor⟩ := linearMap_product_factor_first q hkill + refine ⟨q₁, ?_⟩ + intro t + obtain ⟨z, hz⟩ := hq t + refine ⟨z.1, ?_⟩ + rw [hfactor] at hz + simpa using hz + +/-- If a module `P` is identified with a projective left ideal times a free +factor, and a quotient map kills that free factor, then the target is a +homomorphic image of the projective left ideal. Here `I : Submodule R R` is +a left ideal of the ring. -/ +theorem projective_leftIdeal_image_of_terminal_split + (I : Submodule R R) [Module.Projective R I] + (e : P ≃ₗ[R] I × F) + (q : P →ₗ[R] T) (hq : Function.Surjective q) + (hkill : ∀ z : F, q (e.symm (0, z)) = 0) : + ∃ qI : I →ₗ[R] T, + Function.Surjective qI ∧ Module.Projective R I := by + let qprod : I × F →ₗ[R] T := q.comp e.symm.toLinearMap + have hqprod : Function.Surjective qprod := by + intro t + obtain ⟨p, hp⟩ := hq t + refine ⟨e p, ?_⟩ + simpa [qprod] using hp + have hkillprod : ∀ z : F, qprod (0, z) = 0 := by + intro z + exact hkill z + obtain ⟨qI, hqI⟩ := surjective_factor_first_of_surjective qprod hkillprod hqprod + exact ⟨qI, hqI, inferInstance⟩ + + +end AlgebraicAnalysis.TorsionProjectiveImage diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/TriangularDenominator.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/TriangularDenominator.lean new file mode 100644 index 0000000000..2cb9bf4258 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/TriangularDenominator.lean @@ -0,0 +1,132 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightIntersection + + +/-! +# Generic finite triangular denominator arguments + +This file records the purely module-theoretic part of the triangular +denominator argument. The coefficients act on the right, represented by +scalars in `Rᵐᵒᵖ`; in particular `(op s) • m` means `m * s`. + +There are two useful forms. First, a finite family of torsion generators has +one common nonzero denominator, obtained from the finite intersection of their +right annihilator ideals. Second, explicit denominator clearance through a +finite filtration composes to denominator clearance for the whole quotient. +The hypotheses describing the filtration are data, rather than an assertion +that an arbitrary Ore extension is free or flat. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis +namespace TriangularDenominator + +open MulOpposite +open AlgebraicAnalysis.OreRightIntersection + +universe u v + +section FiniteGenerators + +variable {R : Type u} [Ring R] [IsDomain R] +variable {M : Type v} [AddCommGroup M] [Module Rᵐᵒᵖ M] + +/-- The right-action map associated to a vector. -/ +def rightActionLinear (m : M) : R →ₗ[Rᵐᵒᵖ] M where + toFun s := (op s) • m + map_add' s t := by + simp [add_smul] + map_smul' a s := by + change (op (s * unop a)) • m = a • ((op s) • m) + rw [op_mul, smul_smul] + rfl + +/-- The right annihilator of a vector, represented as a right ideal. -/ +def rightAnnihilator (m : M) : Submodule Rᵐᵒᵖ R := + LinearMap.ker (rightActionLinear m) + +/-- A finite family of torsion vectors admits one common nonzero denominator. -/ +theorem finite_vectors_common_annihilator + {n : ℕ} (g : Fin n → M) + (hAnn : ∀ i, ∃ s : R, s ≠ 0 ∧ (op s) • g i = 0) + (hOre : RightOreCondition R) : + ∃ s : R, s ≠ 0 ∧ ∀ i, (op s) • g i = 0 := by + classical + let I : Fin n → Submodule Rᵐᵒᵖ R := fun i => rightAnnihilator (g i) + have hI : ∀ i ∈ (Finset.univ : Finset (Fin n)), + ∃ x ∈ I i, x ≠ 0 := by + intro i hi + rcases hAnn i with ⟨s, hs, hsg⟩ + refine ⟨s, ?_, hs⟩ + apply LinearMap.mem_ker.mpr + exact hsg + obtain ⟨s, hs, hsI⟩ := + exists_mem_finset_rightIdeals (R := R) (Finset.univ : Finset (Fin n)) I hI hOre + refine ⟨s, hs, ?_⟩ + intro i + exact LinearMap.mem_ker.mp (hsI i (Finset.mem_univ i)) + +end FiniteGenerators + +section Filtration + +variable {R : Type u} [Ring R] [IsDomain R] +variable {M : Type v} [AddCommGroup M] [Module Rᵐᵒᵖ M] + +/-- One explicit denominator-clearing step of a filtration. -/ +def StepClearance (F : ℕ → Submodule Rᵐᵒᵖ M) (i : ℕ) : Prop := + ∀ m : M, m ∈ F (i + 1) → + ∃ s : R, s ≠ 0 ∧ (op s) • m ∈ F i + +/-- Iterating finitely many explicit triangular steps clears a denominator. -/ +theorem filtration_clearance + (F : ℕ → Submodule Rᵐᵒᵖ M) (n : ℕ) + (hstep : ∀ i < n, StepClearance F i) {m : M} (hm : m ∈ F n) : + ∃ s : R, s ≠ 0 ∧ (op s) • m ∈ F 0 := by + induction n generalizing m with + | zero => + refine ⟨1, one_ne_zero, ?_⟩ + simpa using hm + | succ n ih => + rcases hstep n (Nat.lt_succ_self n) m hm with ⟨s, hs, hsm⟩ + have hstep' : ∀ i < n, StepClearance F i := by + intro i hi + exact hstep i (by omega) + rcases ih hstep' hsm with ⟨t, ht, htm⟩ + refine ⟨s * t, mul_ne_zero hs ht, ?_⟩ + simpa only [op_mul, smul_smul] using htm + +/-- A finite cleared filtration makes the terminal quotient torsion. -/ +def IsTorsionRight (N : Submodule Rᵐᵒᵖ M) : Prop := + ∀ z : M ⧸ N, ∃ s : R, s ≠ 0 ∧ (op s) • z = 0 + +theorem filtration_quotient_isTorsion + (F : ℕ → Submodule Rᵐᵒᵖ M) (n : ℕ) + (hstep : ∀ i < n, StepClearance F i) + (htop : F n = ⊤) : + IsTorsionRight (R := R) (M := M) (F 0) := by + intro z + refine Submodule.Quotient.induction_on (F 0) z ?_ + intro m + have hm : m ∈ F n := by + rw [htop] + trivial + rcases filtration_clearance F n hstep hm with ⟨s, hs, hsm⟩ + refine ⟨s, hs, ?_⟩ + change (F 0).mkQ ((op s) • m) = 0 + rw [Submodule.mkQ_apply, Submodule.Quotient.mk_eq_zero] + exact hsm + +end Filtration + + +end TriangularDenominator +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/TwoSimplicity.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/TwoSimplicity.lean new file mode 100644 index 0000000000..88fa8ed39e --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/TwoSimplicity.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.BigOperators.Group.Finset.Defs +public import Mathlib.Algebra.Ring.Hom.Defs +public import Mathlib.Data.Fintype.Basic +public import Mathlib.Tactic + + +/-! +# Abstract two-simplicity transfer + +This file records the ring-theoretic transfer from a principal-right-quotient +torsion statement to two-simplicity. It does not assert the localization or +rank theorem needed to produce that torsion statement. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.TwoSimplicity + +variable {Λ Γ : Type*} [Ring Λ] [Ring Γ] + +/-- The two-sided coefficient identity used for two-simplicity. -/ +def TwoSimple (R : Type*) [Ring R] : Prop := + ∀ d₁ d₂ : R, d₁ ≠ 0 → d₂ ≠ 0 → + ∃ f g u v : R, f * d₁ * u + g * d₂ * v = 1 + +/-- Finite, torsion-free bimodule extension data with written orders visible. -/ +structure FiniteTorsionFreeExtension (ι : Λ →+* Γ) : Prop where + injective : Function.Injective ι + rightFinite : ∃ n : ℕ, ∃ basis : Fin n → Γ, + ∀ x : Γ, ∃ a : Fin n → Λ, x = ∑ i, basis i * ι (a i) + leftFinite : ∃ n : ℕ, ∃ basis : Fin n → Γ, + ∀ x : Γ, ∃ a : Fin n → Λ, x = ∑ i, ι (a i) * basis i + rightTorsionFree : ∀ a : Λ, a ≠ 0 → ∀ x : Γ, x * ι a = 0 → x = 0 + leftTorsionFree : ∀ a : Λ, a ≠ 0 → ∀ x : Γ, ι a * x = 0 → x = 0 + +/-- The exact class-of-`1` torsion statement needed by the transfer. -/ +def PrincipalRightQuotientTorsion (ι : Λ →+* Γ) : Prop := + ∀ d : Γ, d ≠ 0 → + ∃ a : Λ, a ≠ 0 ∧ ∃ w : Γ, ι a = d * w + +/-- +Two-simplicity transfers along a ring map once the principal right-quotient +torsion condition is supplied. Producing that condition is a separate +localization/rank theorem. +-/ +theorem twoSimple_of_principalRightQuotientTorsion + (ι : Λ →+* Γ) + (hΛ : TwoSimple Λ) + (hquot : PrincipalRightQuotientTorsion ι) : + TwoSimple Γ := by + intro d₁ d₂ hd₁ hd₂ + obtain ⟨a₁, ha₁, w₁, hw₁⟩ := hquot d₁ hd₁ + obtain ⟨a₂, ha₂, w₂, hw₂⟩ := hquot d₂ hd₂ + obtain ⟨f, g, u, v, huv⟩ := hΛ a₁ a₂ ha₁ ha₂ + refine ⟨ι f, ι g, w₁ * ι u, w₂ * ι v, ?_⟩ + have h := congrArg ι huv + simpa only [map_add, map_mul, map_one, hw₁, hw₂, mul_assoc] using h + + +end AlgebraicAnalysis.TwoSimplicity diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/TwoTermPageLength.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/TwoTermPageLength.lean new file mode 100644 index 0000000000..f4d80dcb3d --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/TwoTermPageLength.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.Length +public import Mathlib.LinearAlgebra.Isomorphisms +public import Mathlib.Tactic + + +/-! +Length comparison for stabilized two-term pages with exhaustive target boundaries. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.TwoTermPageLength + +open scoped ENat + +theorem exists_boundary_eq_top_of_iSup_eq_top + {R M : Type*} [Semiring R] [AddCommMonoid M] [Module R M] + [IsNoetherian R M] (D : ℕ →o Submodule R M) (hD : ⨆ r, D r = ⊤) : + ∃ N, D N = ⊤ := by + obtain ⟨N, hN⟩ := (IsNoetherian.noetherian (⊤ : Submodule R M)).stabilizes_of_iSup_eq D hD + exact ⟨N, hN.symm⟩ + +theorem twoTermPage_length_target_le_source + {R : Type*} [Ring R] + (A C : ℕ → Type*) + [∀ r, AddCommGroup (A r)] [∀ r, Module R (A r)] + [∀ r, AddCommGroup (C r)] [∀ r, Module R (C r)] + (hA0 : IsFiniteLength R (A 0)) + (hC0 : IsFiniteLength R (C 0)) + (d : ∀ r, A r →ₗ[R] C r) + (sourceSucc : ∀ r, A (r + 1) ≃ₗ[R] LinearMap.ker (d r)) + (targetSucc : ∀ r, C (r + 1) ≃ₗ[R] C r ⧸ LinearMap.range (d r)) + (N : ℕ) [Subsingleton (C N)] : + Module.length R (C 0) ≤ Module.length R (A 0) := by + have hA : ∀ r, IsFiniteLength R (A r) := by + intro r + induction r with + | zero => exact hA0 + | succ r ihr => + apply (sourceSucc r).symm.isFiniteLength + exact IsFiniteLength.of_injective ihr (Submodule.subtype_injective _) + have hC : ∀ r, IsFiniteLength R (C r) := by + intro r + induction r with + | zero => exact hC0 + | succ r ihr => + apply (targetSucc r).symm.isFiniteLength + exact IsFiniteLength.of_surjective ihr (Submodule.mkQ_surjective _) + let : ∀ r, IsNoetherian R (A r) := fun r => + (isFiniteLength_iff_isNoetherian_isArtinian.mp (hA r)).1 + let : ∀ r, IsArtinian R (A r) := fun r => + (isFiniteLength_iff_isNoetherian_isArtinian.mp (hA r)).2 + let : ∀ r, IsNoetherian R (C r) := fun r => + (isFiniteLength_iff_isNoetherian_isArtinian.mp (hC r)).1 + let : ∀ r, IsArtinian R (C r) := fun r => + (isFiniteLength_iff_isNoetherian_isArtinian.mp (hC r)).2 + have source_length (r : ℕ) : + Module.length R (A r) = + Module.length R (A (r + 1)) + Module.length R (LinearMap.range (d r)) := by + rw [(sourceSucc r).length_eq] + exact Module.length_eq_add_of_exact + (LinearMap.ker (d r)).subtype (d r).rangeRestrict + (Submodule.subtype_injective _) + (LinearMap.range_eq_top.mp (LinearMap.range_rangeRestrict (d r))) + (by + rw [LinearMap.exact_iff, Submodule.range_subtype, LinearMap.ker_rangeRestrict]) + have target_length (r : ℕ) : + Module.length R (C r) = + Module.length R (LinearMap.range (d r)) + Module.length R (C (r + 1)) := by + rw [(targetSucc r).length_eq] + exact Module.length_eq_add_of_exact + (LinearMap.range (d r)).subtype (LinearMap.range (d r)).mkQ + (Submodule.subtype_injective _) (Submodule.mkQ_surjective _) + (LinearMap.exact_subtype_mkQ _) + have source_ne_top (r : ℕ) : Module.length R (A r) ≠ ⊤ := Module.length_ne_top + have target_ne_top (r : ℕ) : Module.length R (C r) ≠ ⊤ := Module.length_ne_top + have range_ne_top (r : ℕ) : Module.length R (LinearMap.range (d r)) ≠ ⊤ := by + exact Module.length_ne_top + have invariant : ∀ n, + ENat.toNat (Module.length R (C 0)) + ENat.toNat (Module.length R (A n)) = + ENat.toNat (Module.length R (A 0)) + ENat.toNat (Module.length R (C n)) := by + intro n + induction n with + | zero => simp [add_comm] + | succ n ih => + have hs := congrArg ENat.toNat (source_length n) + have ht := congrArg ENat.toNat (target_length n) + rw [ENat.toNat_add (source_ne_top (n + 1)) (range_ne_top n)] at hs + rw [ENat.toNat_add (range_ne_top n) (target_ne_top (n + 1))] at ht + omega + have h := invariant N + have hCN : ENat.toNat (Module.length R (C N)) = 0 := by simp + rw [hCN, add_zero] at h + have hnat : ENat.toNat (Module.length R (C 0)) ≤ + ENat.toNat (Module.length R (A 0)) := by omega + rw [← ENat.natCast_toNat (target_ne_top 0), ← ENat.natCast_toNat (source_ne_top 0)] + exact_mod_cast hnat + + +end AlgebraicAnalysis.TwoTermPageLength diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/UniformBoundaryVanishing.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/UniformBoundaryVanishing.lean new file mode 100644 index 0000000000..6dfcc7dfd8 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/UniformBoundaryVanishing.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Module.LocalizedModule.Basic +public import Mathlib.RingTheory.Localization.Module +public import Mathlib.RingTheory.Noetherian.Filter + + +/-! +# Uniform vanishing of an ascending family of boundary maps + +Pointwise eventual vanishing becomes uniform on a Noetherian source. The +localized statement deliberately assumes Noetherianity only after +localization. +-/ + +@[expose] public section + +open IsNoetherian + +namespace AlgebraicAnalysis + +theorem exists_uniform_zero_of_noetherian + {R U : Type*} [Semiring R] [AddCommMonoid U] [Module R U] + {V : ℕ → Type*} [∀ r, AddCommMonoid (V r)] [∀ r, Module R (V r)] + (b : ∀ r, U →ₗ[R] V r) + (hmono : ∀ r s, r ≤ s → LinearMap.ker (b r) ≤ LinearMap.ker (b s)) + (hpoint : ∀ u, ∃ r, b r u = 0) [IsNoetherian R U] : + ∃ r, b r = 0 := by + let F : ℕ →o Submodule R U := + { toFun := fun r => LinearMap.ker (b r) + monotone' := fun r s hrs => hmono r s hrs } + obtain ⟨n, hn⟩ := monotone_stabilizes_iff_noetherian.mpr inferInstance F + refine ⟨n, LinearMap.ext fun u => ?_⟩ + obtain ⟨r, hr⟩ := hpoint u + have hu : u ∈ F r := LinearMap.mem_ker.mpr hr + have hu' : u ∈ F (max n r) := + (hmono r (max n r) (Nat.le_max_right _ _)) hu + have heq : F n = F (max n r) := hn _ (Nat.le_max_left _ _) + have : u ∈ F n := heq.symm ▸ hu' + exact LinearMap.mem_ker.mp this + +theorem exists_uniform_subsingleton_of_noetherian + {R U : Type*} [Semiring R] [AddCommMonoid U] [Module R U] + {V : ℕ → Type*} [∀ r, AddCommMonoid (V r)] [∀ r, Module R (V r)] + (b : ∀ r, U →ₗ[R] V r) + (hmono : ∀ r s, r ≤ s → LinearMap.ker (b r) ≤ LinearMap.ker (b s)) + (hpoint : ∀ u, ∃ r, b r u = 0) + (hsurj : ∀ r, Function.Surjective (b r)) [IsNoetherian R U] : + ∃ r, Subsingleton (V r) := by + obtain ⟨r, hr⟩ := exists_uniform_zero_of_noetherian b hmono hpoint + refine ⟨r, ?_⟩ + constructor + intro x y + obtain ⟨u, rfl⟩ := hsurj r x + obtain ⟨v, rfl⟩ := hsurj r y + simp [hr] + +section Localized + +variable {R : Type*} [CommRing R] (S : Submonoid R) +variable {U : Type*} [AddCommMonoid U] [Module R U] +variable {V : ℕ → Type*} [∀ r, AddCommMonoid (V r)] [∀ r, Module R (V r)] + +private theorem localized_ker_mono + (b : ∀ r, U →ₗ[R] V r) + (hmono : ∀ r s, r ≤ s → LinearMap.ker (b r) ≤ LinearMap.ker (b s)) + {r s : ℕ} (hrs : r ≤ s) : + LinearMap.ker (LocalizedModule.map S (b r)) ≤ + LinearMap.ker (LocalizedModule.map S (b s)) := by + intro z hz + induction z using LocalizedModule.induction_on with + | _ u t => + have hz' := LinearMap.mem_ker.mp hz + rw [LocalizedModule.map_mk] at hz' + change LocalizedModule.mk (b r u) t = 0 at hz' + apply LinearMap.mem_ker.mpr + rw [LocalizedModule.map_mk] + change LocalizedModule.mk (b s u) t = 0 + rw [IsLocalizedModule.mk_eq_mk' (S := S)] at hz' ⊢ + rw [IsLocalizedModule.mk'_eq_zero' (LocalizedModule.mkLinearMap S (V r))] at hz' + obtain ⟨a, ha⟩ := hz' + have hscaled : b r (a • u) = 0 := by + simpa [map_smul] using ha + have hscaled' : b s (a • u) = 0 := + LinearMap.mem_ker.mp (hmono r s hrs (LinearMap.mem_ker.mpr hscaled)) + rw [IsLocalizedModule.mk'_eq_zero'] + exact ⟨a, by simpa [map_smul] using hscaled'⟩ + +theorem exists_uniform_zero_localized + (b : ∀ r, U →ₗ[R] V r) + (hmono : ∀ r s, r ≤ s → LinearMap.ker (b r) ≤ LinearMap.ker (b s)) + (hpoint : ∀ u, ∃ r, b r u = 0) + [IsNoetherian (Localization S) (LocalizedModule S U)] : + ∃ r, LocalizedModule.map S (b r) = 0 := by + let B : ∀ r, LocalizedModule S U →ₗ[Localization S] + LocalizedModule S (V r) := fun r => LocalizedModule.map S (b r) + have hpoint' : ∀ u, ∃ r, B r u = 0 := by + intro u + induction u using LocalizedModule.induction_on with + | _ m s => + obtain ⟨r, hr⟩ := hpoint m + refine ⟨r, ?_⟩ + simp [B, LocalizedModule.map_mk, hr] + obtain ⟨r, hr⟩ := exists_uniform_zero_of_noetherian B + (fun r s hrs => by simpa only [B] using localized_ker_mono S b hmono hrs) hpoint' + exact ⟨r, by simpa [B] using hr⟩ + +theorem exists_uniform_subsingleton_localized + (b : ∀ r, U →ₗ[R] V r) + (hmono : ∀ r s, r ≤ s → LinearMap.ker (b r) ≤ LinearMap.ker (b s)) + (hpoint : ∀ u, ∃ r, b r u = 0) + (hsurj : ∀ r, Function.Surjective (b r)) + [IsNoetherian (Localization S) (LocalizedModule S U)] : + ∃ r, Subsingleton (LocalizedModule S (V r)) := by + let B : ∀ r, LocalizedModule S U →ₗ[Localization S] + LocalizedModule S (V r) := fun r => LocalizedModule.map S (b r) + have hsurj' : ∀ r, Function.Surjective (B r) := by + intro r + exact LocalizedModule.map_surjective S (b r) (hsurj r) + exact exists_uniform_subsingleton_of_noetherian B + (fun r s hrs => by simpa [B] using localized_ker_mono S b hmono hrs) (by + intro u + induction u using LocalizedModule.induction_on with + | _ m s => + obtain ⟨r, hr⟩ := hpoint m + refine ⟨r, ?_⟩ + simp [B, LocalizedModule.map_mk, hr]) hsurj' + +end Localized + + +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Module/Unimodular.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Module/Unimodular.lean new file mode 100644 index 0000000000..063f40db26 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Module/Unimodular.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Module.Projective +public import Mathlib.Tactic + + +/-! +# Unimodular elements and a free rank-one summand + +This file contains the unconditional module-theoretic splitting associated +to a unimodular element. It uses no rank, Ore, simplicity, or finiteness +hypothesis. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.Unimodular + +variable {R N : Type*} [Ring R] [AddCommGroup N] [Module R N] + +/-- An element of a left module is unimodular if a left-linear functional + takes it to `1`. -/ +def IsUnimodular (x : N) : Prop := ∃ φ : N →ₗ[R] R, φ x = 1 + +theorem exists_unimodular_iff_surjective : + (∃ x : N, IsUnimodular (R := R) x) ↔ + ∃ φ : N →ₗ[R] R, Function.Surjective φ := by + constructor + · rintro ⟨x, φ, hφ⟩ + exact ⟨φ, fun r ↦ by + refine ⟨r • x, ?_⟩ + rw [φ.map_smul, hφ, smul_eq_mul, mul_one] + ⟩ + · rintro ⟨φ, hφ⟩ + obtain ⟨x', hx'⟩ := hφ 1 + exact ⟨x', φ, hx'⟩ + +/-- The projection onto the kernel of a functional which is normalized at + `x`. -/ +def unimodularKernelProjection (φ : N →ₗ[R] R) (x : N) + (hx : φ x = 1) : N →ₗ[R] LinearMap.ker φ := + (LinearMap.id - (LinearMap.toSpanSingleton R N x).comp φ).codRestrict + (LinearMap.ker φ) (by + intro y + rw [LinearMap.mem_ker] + simp only [LinearMap.sub_apply, LinearMap.id_apply, LinearMap.coe_comp, + Function.comp_apply, LinearMap.toSpanSingleton_apply] + rw [φ.map_sub, φ.map_smul, hx, smul_eq_mul, mul_one, sub_self]) + +/-- The canonical splitting map associated to a normalized functional. -/ +def unimodularSplitMap (φ : N →ₗ[R] R) (x : N) (hx : φ x = 1) : + N →ₗ[R] LinearMap.ker φ × R := + (unimodularKernelProjection φ x hx).prod φ + +/-- The inverse map to `unimodularSplitMap`. -/ +def unimodularSplitMapInv (φ : N →ₗ[R] R) (x : N) : + LinearMap.ker φ × R →ₗ[R] N := + { toFun := fun y ↦ y.1.1 + y.2 • x + map_add' := by + intro y z + simp only [Prod.fst_add, Prod.snd_add, Submodule.coe_add, add_smul] + abel + map_smul' := by + rintro r ⟨y, s⟩ + dsimp + rw [smul_add, mul_smul] + } + +theorem unimodularSplitMap_left_inverse + (φ : N →ₗ[R] R) (x : N) (hx : φ x = 1) : + (unimodularSplitMapInv φ x).comp (unimodularSplitMap φ x hx) = + LinearMap.id := by + apply LinearMap.ext + intro y + dsimp [unimodularSplitMap, unimodularSplitMapInv, + unimodularKernelProjection] + change (y - φ y • x) + φ y • x = y + exact sub_add_cancel _ _ + +theorem unimodularSplitMap_right_inverse + (φ : N →ₗ[R] R) (x : N) (hx : φ x = 1) : + (unimodularSplitMap φ x hx).comp (unimodularSplitMapInv φ x) = + LinearMap.id := by + apply LinearMap.ext + rintro ⟨y, r⟩ + dsimp [unimodularSplitMap, unimodularSplitMapInv, + unimodularKernelProjection] + apply Prod.ext + · apply Subtype.ext + change y.1 + r • x - φ (y.1 + r • x) • x = y.1 + rw [φ.map_add, φ.map_smul, LinearMap.mem_ker.mp y.2] + simp [hx, smul_eq_mul] + · simp only [ LinearMap.prod_apply] + change φ (y.1 + r • x) = r + rw [φ.map_add, φ.map_smul, LinearMap.mem_ker.mp y.2, hx] + simp [smul_eq_mul] + +/-- A unimodular element splits off a free rank-one factor. -/ +def unimodularSplitEquiv (φ : N →ₗ[R] R) (x : N) (hx : φ x = 1) : + N ≃ₗ[R] LinearMap.ker φ × R := + LinearEquiv.ofLinearMap (unimodularSplitMap φ x hx) + (unimodularSplitMapInv φ x) + (unimodularSplitMap_right_inverse φ x hx) + (unimodularSplitMap_left_inverse φ x hx) + +theorem unimodular_split (x : N) (hx : IsUnimodular (R := R) x) : + ∃ φ : N →ₗ[R] R, ∃ _hφ : φ x = 1, + Nonempty (N ≃ₗ[R] LinearMap.ker φ × R) := by + obtain ⟨φ, hφ⟩ := hx + exact ⟨φ, hφ, ⟨unimodularSplitEquiv φ x hφ⟩⟩ + +/-- The cyclic submodule generated by a unimodular element is a free + rank-one module. The target is the actual range, so no commutativity or + centrality assumption on `R` is hidden in the statement. -/ +theorem unimodular_span_singleton_free (x : N) + (hx : IsUnimodular (R := R) x) : + Module.Free R (LinearMap.range (LinearMap.toSpanSingleton R N x)) := by + obtain ⟨φ, hφ⟩ := hx + let e : R ≃ₗ[R] LinearMap.range (LinearMap.toSpanSingleton R N x) := + LinearEquiv.ofInjective (LinearMap.toSpanSingleton R N x) (by + intro r s hrs + change r • x = s • x at hrs + have hzero : (r - s) • x = 0 := by + rw [sub_smul, hrs, sub_self] + have hzero' := congrArg φ hzero + have hrs' : r - s = 0 := by + simpa [φ.map_smul, hφ, smul_eq_mul] using hzero' + exact sub_eq_zero.mp hrs') + exact Module.Free.of_equiv e + +/-- The kernel of a split functional is a direct summand of its domain. In + particular, if the domain is projective then this kernel is projective. -/ +theorem projective_ker_of_unimodular + [Module.Projective R N] (φ : N →ₗ[R] R) (x : N) (hx : φ x = 1) : + Module.Projective R (LinearMap.ker φ) := by + apply Module.Projective.of_split (LinearMap.ker φ).subtype + (unimodularKernelProjection φ x hx) + apply LinearMap.ext + intro y + apply Subtype.ext + dsimp [unimodularKernelProjection] + change y.1 - φ y.1 • x = y.1 + rw [LinearMap.mem_ker.mp y.2, zero_smul, sub_zero] + + +end AlgebraicAnalysis.Unimodular diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/ActiveCoordinate.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/ActiveCoordinate.lean new file mode 100644 index 0000000000..f625ae61f4 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/ActiveCoordinate.lean @@ -0,0 +1,201 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Associativity + + +/-! +# Active-coordinate decomposition in a derivation Ore extension + +This file isolates a reusable algebraic interface for one distinguished +coefficient coordinate. The coefficient ring may be noncommutative; the +coordinate is required to be central in that ring, while the active derivation +annihilates ground scalars and sends the coordinate to `1`. + +The results use only the checked normal-form construction. They do not +postulate a PBW basis, a presented Weyl algebra, or an operator realization. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.OreActiveCoordinate + +open Polynomial +open AlgebraicAnalysis +open AlgebraicAnalysis.OreDivision +open AlgebraicAnalysis.OreAssociativity + +noncomputable section + + +/-! ## The source-relative active-coordinate data -/ + +/-- Hypotheses for one active differential-Ore coordinate. + +The coefficient ring can be noncommutative. `coordinate_central` is the exact +hypothesis needed for coefficients of an active-variable expansion to commute +with polynomials in the coordinate. The two derivation hypotheses record that +the active derivation fixes ground scalars and differentiates the coordinate. +-/ +structure ActiveCoordinateData (k C : Type*) [CommRing k] [Ring C] + [Algebra k C] where + /-- The coefficient derivation defining the Ore relation. -/ + derivation : OreDivisionDerivation C + /-- The distinguished central coefficient coordinate. -/ + coordinate : C + coordinate_central : ∀ c : C, Commute coordinate c + derivation_smul : ∀ a : k, derivation (algebraMap k C a) = 0 + derivation_coordinate : derivation coordinate = algebraMap k C 1 + +namespace ActiveCoordinateData + +variable {k C : Type*} [CommRing k] [Ring C] [Algebra k C] +variable (A : ActiveCoordinateData k C) + +/-- The active one-variable derivation Ore ring. -/ +abbrev Ore := NormalOre A.derivation + +/-- The coefficient embedding into the active Ore ring. -/ +def coefficient (c : C) : A.Ore := normalCoefficient A.derivation c + +/-- The active Ore variable. -/ +def activeVariable : A.Ore := normalVariable A.derivation + +/-- The central-coordinate polynomial algebra inside the active Ore ring. -/ +def coordinatePolynomial (p : Polynomial k) : A.Ore := + p.eval₂ ((normalCoefficient A.derivation).comp (algebraMap k C)) + (coefficient A A.coordinate) + +/-- The defining differential-Ore relation at the distinguished coordinate. -/ +theorem variable_mul_coordinate : + activeVariable A * coefficient A A.coordinate = + coefficient A A.coordinate * activeVariable A + + coefficient A (algebraMap k C 1) := by + unfold activeVariable coefficient + rw [normalVariable_mul_coefficient] + rw [A.derivation_coordinate] + +/-- Ground scalars commute with the active Ore variable. -/ +theorem variable_mul_smul (a : k) : + activeVariable A * coefficient A (algebraMap k C a) = + coefficient A (algebraMap k C a) * activeVariable A := by + unfold activeVariable coefficient + rw [normalVariable_mul_coefficient, A.derivation_smul, map_zero] + simp + +/-- Every coefficient commutes with the image of a ground scalar. -/ +theorem coefficient_commute_smul (c : C) (a : k) : + Commute (coefficient A c) (coefficient A (algebraMap k C a)) := by + unfold coefficient + rw [commute_iff_eq] + rw [← (normalCoefficient A.derivation).map_mul, + ← (normalCoefficient A.derivation).map_mul] + rw [Algebra.commutes] + +/-- Every coefficient commutes with the distinguished coordinate. -/ +theorem coefficient_commute_coordinate (c : C) : + Commute (coefficient A c) (coefficient A A.coordinate) := by + unfold coefficient + rw [commute_iff_eq] + rw [← (normalCoefficient A.derivation).map_mul, + ← (normalCoefficient A.derivation).map_mul] + rw [A.coordinate_central c |>.symm.eq] + +/-- Every coefficient commutes with every polynomial in the central coordinate. -/ +theorem coefficient_commute_coordinatePolynomial (c : C) + (p : Polynomial k) : + Commute (coefficient A c) (coordinatePolynomial A p) := by + induction p using Polynomial.induction_on' with + | add p q hp hq => + rw [coordinatePolynomial, eval₂_add] + exact hp.add_right hq + | monomial n a => + rw [coordinatePolynomial, eval₂_monomial] + exact (coefficient_commute_smul A c a).mul_right + ((coefficient_commute_coordinate A c).pow_right n) + +/-- The coefficient-left normal form is an explicit finite active-variable +expansion. -/ +theorem normalForm_eq_support_sum (p : Polynomial C) : + normalForm A.derivation p = + ∑ j ∈ p.support, + coefficient A (p.coeff j) * activeVariable A ^ j := by + calc + normalForm A.derivation p = + normalForm A.derivation (∑ j ∈ p.support, + Polynomial.monomial j (p.coeff j)) := by + exact congrArg (normalForm A.derivation) p.as_sum_support + _ = ∑ j ∈ p.support, + normalForm A.derivation (Polynomial.monomial j (p.coeff j)) := by + change normalFormAddHom A.derivation + (∑ j ∈ p.support, Polynomial.monomial j (p.coeff j)) = _ + rw [map_sum] + rfl + _ = ∑ j ∈ p.support, + coefficient A (p.coeff j) * activeVariable A ^ j := by + simp only [normalForm_monomial] + rfl + +/-- Recombination using only coefficient/coordinate commutation; the active +Ore variable remains on the right throughout. -/ +theorem recombine_coordinate_polynomial (p : Polynomial C) + (b : A.Ore) (q : Polynomial k) : + (∑ j ∈ p.support, + (b * coefficient A (p.coeff j)) * + (coordinatePolynomial A q * activeVariable A ^ j)) = + b * coordinatePolynomial A q * normalForm A.derivation p := by + calc + (∑ j ∈ p.support, + (b * coefficient A (p.coeff j)) * + (coordinatePolynomial A q * activeVariable A ^ j)) = + ∑ j ∈ p.support, + b * coordinatePolynomial A q * + (coefficient A (p.coeff j) * activeVariable A ^ j) := by + apply Finset.sum_congr rfl + intro j hj + calc + (b * coefficient A (p.coeff j)) * + (coordinatePolynomial A q * activeVariable A ^ j) = + b * (coefficient A (p.coeff j) * + coordinatePolynomial A q) * activeVariable A ^ j := by + simp only [mul_assoc] + _ = b * (coordinatePolynomial A q * coefficient A (p.coeff j)) * + activeVariable A ^ j := by + rw [(coefficient_commute_coordinatePolynomial A + (p.coeff j) q).eq] + _ = b * coordinatePolynomial A q * + (coefficient A (p.coeff j) * activeVariable A ^ j) := by + simp only [mul_assoc] + _ = b * coordinatePolynomial A q * + (∑ j ∈ p.support, + coefficient A (p.coeff j) * activeVariable A ^ j) := by + symm + rw [Finset.mul_sum] + _ = b * coordinatePolynomial A q * normalForm A.derivation p := by + rw [normalForm_eq_support_sum] + +/-- Normal-form surjectivity supplies a finite active-variable expansion and +the coefficient commutations needed to use it source-relatively. -/ +theorem exists_active_expansion (d : A.Ore) : + ∃ p : Polynomial C, + d = ∑ j ∈ p.support, + coefficient A (p.coeff j) * activeVariable A ^ j ∧ + ∀ n : ℕ, ∀ q : Polynomial k, + Commute (coefficient A (p.coeff n)) + (coordinatePolynomial A q) := by + obtain ⟨p, hp⟩ := normalForm_surjective A.derivation d + refine ⟨p, ?_, ?_⟩ + · rw [← hp, normalForm_eq_support_sum] + · intro n q + exact coefficient_commute_coordinatePolynomial A (p.coeff n) q + +end ActiveCoordinateData + + +end +end AlgebraicAnalysis.OreActiveCoordinate diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/Associativity.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/Associativity.lean new file mode 100644 index 0000000000..10d276dcf0 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/Associativity.lean @@ -0,0 +1,434 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightDivision + + +/-! +# Associativity of derivation Ore normal forms over a noncommutative ring + +This removes the commutativity assumption from the faithful-operator proof of +associativity for `Stafford.OreDivision.rightMul`. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.OreAssociativity + +open Polynomial +open AlgebraicAnalysis +open AlgebraicAnalysis.OreDivision + +noncomputable section + +variable {B : Type*} [Ring B] + +lemma derivation_one (D : OreDivisionDerivation B) : D 1 = 0 := by + have h := D.leibniz 1 1 + simp only [one_mul, mul_one] at h + symm + calc + 0 = D 1 - D 1 := (sub_self _).symm + _ = (D 1 + D 1) - D 1 := by rw [← h] + _ = D 1 := by abel + +/-- Apply the coefficient derivation to every coefficient. -/ +def coefficientDerivation (D : OreDivisionDerivation B) : + Polynomial B →+ Polynomial B where + toFun p := p.sum fun i b => monomial i (D b) + map_zero' := by simp [Polynomial.sum_def] + map_add' p q := by + change (p + q).sum (fun i b => monomial i (D b)) = + p.sum (fun i b => monomial i (D b)) + + q.sum (fun i b => monomial i (D b)) + apply Polynomial.sum_add_index + · intro i + simp [D.map_zero] + · intro i a b + simp [D.map_add] + +@[simp] +lemma coefficientDerivation_monomial + (D : OreDivisionDerivation B) (i : ℕ) (b : B) : + coefficientDerivation D (monomial i b) = monomial i (D b) := by + by_cases hb : b = 0 + · subst b + simp [D.map_zero] + · simp [coefficientDerivation, D.map_zero] + +@[simp] +lemma coefficientDerivation_C_mul + (D : OreDivisionDerivation B) (b : B) (p : Polynomial B) : + coefficientDerivation D (C b * p) = + C b * coefficientDerivation D p + C (D b) * p := by + induction p using Polynomial.induction_on' with + | add p q hp hq => + simp [map_add, hp, hq, mul_add, add_assoc, add_left_comm, + add_comm] + | monomial n a => + simp [D.leibniz] + +/-- Coefficients act by ordinary left multiplication. -/ +def coefficientLeft : B →+* AddMonoid.End (Polynomial B) where + toFun b := + { toFun := fun p => C b * p + map_zero' := by simp + map_add' := by intro p q; simp [mul_add] } + map_one' := by + apply AddMonoidHom.ext + intro p + change C (1 : B) * p = p + simp + map_mul' b c := by + apply AddMonoidHom.ext + intro p + change C (b * c) * p = C b * (C c * p) + simp [mul_assoc] + map_zero' := by + apply AddMonoidHom.ext + intro p + change C (0 : B) * p = 0 + simp + map_add' b c := by + apply AddMonoidHom.ext + intro p + change C (b + c) * p = C b * p + C c * p + simp [add_mul] + +/-- Left multiplication by the Ore variable on normal forms. -/ +def leftOreShift (D : OreDivisionDerivation B) : + AddMonoid.End (Polynomial B) where + toFun p := p * X + coefficientDerivation D p + map_zero' := by simp + map_add' p q := by + simp only [add_mul, map_add] + abel + +/-- The faithful left-regular representation of the one-variable Ore model. -/ +def faithfulAmbient (D : OreDivisionDerivation B) : + OreAmbient B (AddMonoid.End (Polynomial B)) D where + embed := coefficientLeft + x := leftOreShift D + relation := by + intro b + apply AddMonoidHom.ext + intro p + change (C b * p) * X + coefficientDerivation D (C b * p) = + C b * (p * X + coefficientDerivation D p) + C (D b) * p + rw [coefficientDerivation_C_mul] + noncomm_ring + +@[simp] +lemma coefficientDerivation_X_pow + (D : OreDivisionDerivation B) (n : ℕ) : + coefficientDerivation D (X ^ n) = 0 := by + rw [Polynomial.X_pow_eq_monomial, coefficientDerivation_monomial, + derivation_one, monomial_zero_right] + +@[simp] +lemma leftOreShift_X_pow (D : OreDivisionDerivation B) (n : ℕ) : + leftOreShift D (X ^ n) = X ^ (n + 1) := by + change X ^ n * X + coefficientDerivation D (X ^ n) = X ^ (n + 1) + rw [coefficientDerivation_X_pow, add_zero, pow_succ] + +lemma leftOreShift_pow_apply_one (D : OreDivisionDerivation B) (n : ℕ) : + ((leftOreShift D) ^ n) (1 : Polynomial B) = X ^ n := by + induction n with + | zero => simp + | succ n ih => + rw [pow_succ'] + change leftOreShift D (((leftOreShift D) ^ n) 1) = X ^ (n + 1) + rw [ih] + exact leftOreShift_X_pow D n + +lemma faithful_eval_apply_one (D : OreDivisionDerivation B) + (p : Polynomial B) : + OreAmbient.eval D (faithfulAmbient D) p (1 : Polynomial B) = p := by + rw [OreAmbient.eval] + change (p.sum fun i b => + coefficientLeft b * (leftOreShift D) ^ i) 1 = p + rw [Polynomial.sum_def] + calc + (∑ n ∈ p.support, + coefficientLeft (p.coeff n) * (leftOreShift D) ^ n) 1 = + (∑ n ∈ p.support, + ⇑(coefficientLeft (p.coeff n) * (leftOreShift D) ^ n)) 1 := by + exact congrFun + (AddMonoidHom.coe_finsetSum + (fun n => coefficientLeft (p.coeff n) * (leftOreShift D) ^ n) + p.support) (1 : Polynomial B) + _ = ∑ n ∈ p.support, + (coefficientLeft (p.coeff n) * (leftOreShift D) ^ n) 1 := by + exact Finset.sum_apply (1 : Polynomial B) p.support + (fun n => ⇑(coefficientLeft (p.coeff n) * (leftOreShift D) ^ n)) + _ = ∑ n ∈ p.support, + C (p.coeff n) * (((leftOreShift D) ^ n) 1) := by rfl + _ = p := by + simp_rw [leftOreShift_pow_apply_one] + simpa only [Polynomial.sum_def] using Polynomial.sum_C_mul_X_pow_eq p + +theorem faithful_eval_injective (D : OreDivisionDerivation B) : + Function.Injective (OreAmbient.eval D (faithfulAmbient D)) := by + intro p q hpq + have h := DFunLike.congr_fun hpq (1 : Polynomial B) + simpa [faithful_eval_apply_one] using h + +lemma faithful_eval_one (D : OreDivisionDerivation B) : + OreAmbient.eval D (faithfulAmbient D) (1 : Polynomial B) = 1 := by + rw [show (1 : Polynomial B) = C (1 : B) by simp, OreAmbient.eval] + rw [Polynomial.sum_C_index] + · simp [faithfulAmbient] + · simp [faithfulAmbient] + +lemma faithful_eval_C (D : OreDivisionDerivation B) (b : B) : + OreAmbient.eval D (faithfulAmbient D) (C b) = coefficientLeft b := by + rw [OreAmbient.eval, Polynomial.sum_C_index] + · simp [faithfulAmbient] + · simp [faithfulAmbient] + +lemma faithful_eval_X (D : OreDivisionDerivation B) : + OreAmbient.eval D (faithfulAmbient D) X = leftOreShift D := by + rw [← Polynomial.monomial_one_one_eq_X] + rw [OreAmbient.eval_monomial] + simp [faithfulAmbient] + +/-- Associativity of the derivation-corrected normal-form product. -/ +theorem rightMul_assoc_of_ring + (D : OreDivisionDerivation B) (p q r : Polynomial B) : + rightMul D (rightMul D p q) r = + rightMul D p (rightMul D q r) := by + apply faithful_eval_injective D + rw [OreAmbient.eval_rightMul, OreAmbient.eval_rightMul, + OreAmbient.eval_rightMul, OreAmbient.eval_rightMul] + exact mul_assoc _ _ _ + +/-! ## The concrete associative Ore ring -/ + +/-- The image of the faithful normal-form representation. -/ +def faithfulRange (D : OreDivisionDerivation B) : + Subring (AddMonoid.End (Polynomial B)) where + carrier := Set.range (OreAmbient.eval D (faithfulAmbient D)) + zero_mem' := ⟨0, OreAmbient.eval_zero D (faithfulAmbient D)⟩ + one_mem' := ⟨1, faithful_eval_one D⟩ + add_mem' := by + rintro _ _ ⟨p, rfl⟩ ⟨q, rfl⟩ + exact ⟨p + q, OreAmbient.eval_add D (faithfulAmbient D) p q⟩ + neg_mem' := by + rintro _ ⟨p, rfl⟩ + exact ⟨-p, map_neg (OreAmbient.evalAddHom D (faithfulAmbient D)) p⟩ + mul_mem' := by + rintro _ _ ⟨p, rfl⟩ ⟨q, rfl⟩ + exact ⟨rightMul D p q, OreAmbient.eval_rightMul D (faithfulAmbient D) p q⟩ + +/-- The one-variable derivation Ore extension, represented faithfully by its +left-regular action on normal polynomials. -/ +abbrev NormalOre (D : OreDivisionDerivation B) := faithfulRange D + +/-- A coefficient-left polynomial regarded as an element of the Ore ring. -/ +def normalForm (D : OreDivisionDerivation B) (p : Polynomial B) : NormalOre D := + ⟨OreAmbient.eval D (faithfulAmbient D) p, ⟨p, rfl⟩⟩ + +@[simp] +theorem normalForm_injective (D : OreDivisionDerivation B) : + Function.Injective (normalForm D) := by + intro p q h + apply faithful_eval_injective D + exact Subtype.ext_iff.mp h + +theorem normalForm_surjective (D : OreDivisionDerivation B) : + Function.Surjective (normalForm D) := by + rintro ⟨_, p, rfl⟩ + exact ⟨p, rfl⟩ + +@[simp] +theorem normalForm_zero (D : OreDivisionDerivation B) : + normalForm D 0 = 0 := by + apply Subtype.ext + exact OreAmbient.eval_zero D (faithfulAmbient D) + +@[simp] +theorem normalForm_one (D : OreDivisionDerivation B) : + normalForm D 1 = 1 := by + apply Subtype.ext + exact faithful_eval_one D + +@[simp] +theorem normalForm_add (D : OreDivisionDerivation B) + (p q : Polynomial B) : + normalForm D (p + q) = normalForm D p + normalForm D q := by + apply Subtype.ext + exact OreAmbient.eval_add D (faithfulAmbient D) p q + +@[simp] +theorem normalForm_neg (D : OreDivisionDerivation B) + (p : Polynomial B) : normalForm D (-p) = -normalForm D p := by + apply Subtype.ext + exact map_neg (OreAmbient.evalAddHom D (faithfulAmbient D)) p + +@[simp] +theorem normalForm_mul (D : OreDivisionDerivation B) + (p q : Polynomial B) : + normalForm D (rightMul D p q) = normalForm D p * normalForm D q := by + apply Subtype.ext + exact OreAmbient.eval_rightMul D (faithfulAmbient D) p q + +/-- The normal-form map as an additive homomorphism. -/ +def normalFormAddHom (D : OreDivisionDerivation B) : + Polynomial B →+ NormalOre D where + toFun := normalForm D + map_zero' := normalForm_zero D + map_add' := normalForm_add D + +/-- Normal forms are additively equivalent to ordinary coefficient-left +polynomials. -/ +def normalFormAddEquiv (D : OreDivisionDerivation B) : + Polynomial B ≃+ NormalOre D := + AddEquiv.ofBijective (normalFormAddHom D) + ⟨normalForm_injective D, normalForm_surjective D⟩ + +/-- The canonical coefficient embedding. -/ +def normalCoefficient (D : OreDivisionDerivation B) : B →+* NormalOre D := + coefficientLeft.codRestrict (faithfulRange D) fun b => by + exact ⟨C b, faithful_eval_C D b⟩ + +@[simp] +theorem normalForm_C (D : OreDivisionDerivation B) (b : B) : + normalForm D (C b) = normalCoefficient D b := by + apply Subtype.ext + exact faithful_eval_C D b + +/-- The canonical Ore variable. -/ +def normalVariable (D : OreDivisionDerivation B) : NormalOre D := + normalForm D X + +theorem normalForm_monomial (D : OreDivisionDerivation B) (n : ℕ) (b : B) : + normalForm D (monomial n b) = + normalCoefficient D b * normalVariable D ^ n := by + apply Subtype.ext + change OreAmbient.eval D (faithfulAmbient D) (monomial n b) = + coefficientLeft b * OreAmbient.eval D (faithfulAmbient D) X ^ n + rw [OreAmbient.eval_monomial, faithful_eval_X] + rfl + +/-- The defining derivation relation `X b = b X + D(b)`. -/ +theorem normalVariable_mul_coefficient (D : OreDivisionDerivation B) (b : B) : + normalVariable D * normalCoefficient D b = + normalCoefficient D b * normalVariable D + normalCoefficient D (D b) := by + apply Subtype.ext + change + OreAmbient.eval D (faithfulAmbient D) X * coefficientLeft b = + coefficientLeft b * OreAmbient.eval D (faithfulAmbient D) X + + coefficientLeft (D b) + rw [faithful_eval_X] + exact (faithfulAmbient D).relation b + +/-! ## Universal property -/ + +variable {A : Type*} [Ring A] + +lemma ambient_eval_one (D : OreDivisionDerivation B) (O : OreAmbient B A D) : + OreAmbient.eval D O (1 : Polynomial B) = 1 := by + rw [show (1 : Polynomial B) = C (1 : B) by simp, OreAmbient.eval] + rw [Polynomial.sum_C_index] + · simp + · simp + +lemma ambient_eval_C (D : OreDivisionDerivation B) (O : OreAmbient B A D) + (b : B) : OreAmbient.eval D O (C b) = O.embed b := by + rw [OreAmbient.eval, Polynomial.sum_C_index] + · simp + · simp + +lemma ambient_eval_X (D : OreDivisionDerivation B) (O : OreAmbient B A D) : + OreAmbient.eval D O X = O.x := by + rw [← Polynomial.monomial_one_one_eq_X, OreAmbient.eval_monomial] + simp + +/-- The universal map out of the concrete Ore ring. -/ +def oreLift (D : OreDivisionDerivation B) (O : OreAmbient B A D) : + NormalOre D →+* A where + toFun z := OreAmbient.eval D O ((normalFormAddEquiv D).symm z) + map_zero' := by + change OreAmbient.eval D O ((normalFormAddEquiv D).symm 0) = 0 + rw [(normalFormAddEquiv D).symm.map_zero] + exact OreAmbient.eval_zero D O + map_one' := by + have h : (normalFormAddEquiv D).symm (1 : NormalOre D) = 1 := by + apply (normalFormAddEquiv D).injective + simp [normalFormAddEquiv, normalFormAddHom] + change OreAmbient.eval D O ((normalFormAddEquiv D).symm 1) = 1 + rw [h] + exact ambient_eval_one D O + map_add' z w := by + change OreAmbient.eval D O ((normalFormAddEquiv D).symm (z + w)) = + OreAmbient.eval D O ((normalFormAddEquiv D).symm z) + + OreAmbient.eval D O ((normalFormAddEquiv D).symm w) + have h := (normalFormAddEquiv D).symm.toAddHom.map_add z w + change (normalFormAddEquiv D).symm (z + w) = + (normalFormAddEquiv D).symm z + (normalFormAddEquiv D).symm w at h + rw [h] + exact OreAmbient.eval_add D O _ _ + map_mul' z w := by + let p := (normalFormAddEquiv D).symm z + let q := (normalFormAddEquiv D).symm w + have hz : normalForm D p = z := by + change (normalFormAddEquiv D) p = z + exact (normalFormAddEquiv D).apply_symm_apply z + have hw : normalForm D q = w := by + change (normalFormAddEquiv D) q = w + exact (normalFormAddEquiv D).apply_symm_apply w + have hpq : (normalFormAddEquiv D).symm (z * w) = rightMul D p q := by + apply (normalFormAddEquiv D).injective + rw [(normalFormAddEquiv D).apply_symm_apply] + symm + change normalForm D (rightMul D p q) = z * w + rw [normalForm_mul, hz, hw] + change OreAmbient.eval D O ((normalFormAddEquiv D).symm (z * w)) = + OreAmbient.eval D O p * OreAmbient.eval D O q + rw [hpq] + exact OreAmbient.eval_rightMul D O p q + +@[simp] +theorem oreLift_normalForm (D : OreDivisionDerivation B) + (O : OreAmbient B A D) (p : Polynomial B) : + oreLift D O (normalForm D p) = OreAmbient.eval D O p := by + change OreAmbient.eval D O ((normalFormAddEquiv D).symm (normalForm D p)) = _ + rw [show normalForm D p = (normalFormAddEquiv D) p by rfl] + rw [(normalFormAddEquiv D).symm_apply_apply] + +@[simp] +theorem oreLift_coefficient (D : OreDivisionDerivation B) + (O : OreAmbient B A D) (b : B) : + oreLift D O (normalCoefficient D b) = O.embed b := by + rw [← normalForm_C, oreLift_normalForm, ambient_eval_C] + +@[simp] +theorem oreLift_variable (D : OreDivisionDerivation B) + (O : OreAmbient B A D) : oreLift D O (normalVariable D) = O.x := by + rw [normalVariable, oreLift_normalForm, ambient_eval_X] + +/-- A ring map out of `NormalOre D` is uniquely determined by the coefficient +map and the image of the Ore variable. -/ +theorem oreLift_unique (D : OreDivisionDerivation B) (O : OreAmbient B A D) + (g : NormalOre D →+* A) + (hCoefficient : ∀ b, g (normalCoefficient D b) = O.embed b) + (hVariable : g (normalVariable D) = O.x) : + g = oreLift D O := by + ext z + rcases normalForm_surjective D z with ⟨p, rfl⟩ + rw [oreLift_normalForm] + induction p using Polynomial.induction_on' with + | add p q hp hq => + rw [normalForm_add, g.map_add, OreAmbient.eval_add, hp, hq] + | monomial n b => + rw [normalForm_monomial, g.map_mul, g.map_pow, hCoefficient, hVariable, + OreAmbient.eval_monomial] + + +end +end AlgebraicAnalysis.OreAssociativity diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/IteratedPBW.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/IteratedPBW.lean new file mode 100644 index 0000000000..0f18ee06e3 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/IteratedPBW.lean @@ -0,0 +1,151 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.IteratedTower +public import Mathlib.Algebra.Polynomial.Basis +public import Mathlib.LinearAlgebra.Basis.Basic + + +/-! +# Left-field PBW bases for the finite Ore tower + +This is the noncentral left-module layer. Scalars act through the canonical +coefficient embedding at every stage; no centrality of the coefficient field +inside the Ore ring is used. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.OreIteratedPBW + +open Polynomial +open Module +open AlgebraicAnalysis +open AlgebraicAnalysis.OreDivision +open AlgebraicAnalysis.OreAssociativity +open AlgebraicAnalysis.OreIteratedTower + +noncomputable section + + +variable {K : Type*} [Field K] + +/-- A derivation of the field coefficient ring for an Ore stage. -/ +abbrev KDerivation (K : Type*) [Ring K] := OreDivisionDerivation K + +/-- The coefficient embedding into a finite iterated Ore tower. -/ +def towerCoefficient : (Ds : List (KDerivation K)) → + (hDs : PairwiseCommutes Ds) → K →+* OreTower Ds hDs + | [], _ => RingHom.id K + | D :: Ds, hDs => + let T := build Ds hDs.2 + let hD : CommutesWith D Ds := pairwise_head hDs + (normalCoefficient (T.extend D hD)).comp + (towerCoefficient Ds hDs.2) + +instance towerKModule (Ds : List (KDerivation K)) + (hDs : PairwiseCommutes Ds) : Module K (OreTower Ds hDs) := + Module.compHom (OreTower Ds hDs) (towerCoefficient Ds hDs) + +/-- The nested natural-number index type for tower monomials. -/ +def exponentIndex : List (KDerivation K) → Type + | [] => PUnit + | _ :: Ds => ℕ × exponentIndex Ds + +instance polynomialKSMul (R : Type*) [Semiring R] [Module K R] : + SMul K (Polynomial R) := + Polynomial.distribSMul.toSMul + +instance polynomialKModule (R : Type*) [Semiring R] [Module K R] : + Module K (Polynomial R) := + Polynomial.module + +lemma polynomial_smul_eq_C_mul {R : Type*} [Ring R] [Module K R] + (φ : K →+* R) (hφ : ∀ c : K, ∀ r : R, c • r = φ c * r) + (c : K) (p : Polynomial R) : + c • p = Polynomial.C (φ c) * p := by + induction p using Polynomial.induction_on' with + | add p q hp hq => + rw [smul_add, mul_add, hp, hq] + | monomial n r => + apply (Polynomial.toFinsuppIso R).injective + simp [Polynomial.toFinsuppIso, hφ] + +/-- The coefficient-wise additive coordinates of a polynomial. -/ +def polynomialToFinsuppLinearEquiv {R : Type*} [Ring R] + [Module K R] : + Polynomial R ≃ₗ[K] (ℕ →₀ R) := by + exact + { (Polynomial.toFinsuppIso R).toAddEquiv.trans + (AddMonoidAlgebra.coeffLinearEquiv K).toAddEquiv with + map_smul' := by + intro c p + rfl } + +/-- Lift a coefficient basis to the standard polynomial basis. -/ +def polynomialBasis (R : Type*) [Ring R] [Module K R] + (b : Basis ι K R) : + Basis (ℕ × ι) K (Polynomial R) := by + let e : Polynomial R ≃ₗ[K] (ℕ × ι →₀ K) := + (polynomialToFinsuppLinearEquiv (K := K)).trans + ((Finsupp.mapRange.linearEquiv b.repr).trans + (Finsupp.curryLinearEquiv K).symm) + exact Basis.ofRepr e + +/-- The tower normal form as a linear equivalence over the coefficient field. -/ +def normalFormLinearEquivK {R : Type*} [Ring R] + (D : OreDivisionDerivation R) (φ : K →+* R) + (ψ : K →+* NormalOre D) + (hψ : ψ = (normalCoefficient D).comp φ) + [Module K R] [Module K (NormalOre D)] + (hφ : ∀ c : K, ∀ r : R, c • r = φ c * r) + (hsmul : ∀ c : K, ∀ z : NormalOre D, c • z = ψ c * z) : + Polynomial R ≃ₗ[K] NormalOre D := by + exact + { normalFormAddEquiv D with + map_smul' := by + intro c p + change normalForm D (c • p) = c • normalForm D p + rw [polynomial_smul_eq_C_mul φ hφ] + rw [hsmul, hψ] + induction p using Polynomial.induction_on' with + | add p q hp hq => + rw [mul_add, normalForm_add, hp, hq, normalForm_add] + noncomm_ring + | monomial n b => + rw [Polynomial.C_mul_monomial, normalForm_monomial] + rw [normalForm_monomial] + simp [mul_assoc] } + +/-- The PBW basis indexed by nested exponent tuples. -/ +def towerPBWBasis : (Ds : List (KDerivation K)) → + (hDs : PairwiseCommutes Ds) → + letI : Module K (OreTower Ds hDs) := towerKModule Ds hDs + Basis (exponentIndex Ds) K (OreTower Ds hDs) + | [], _ => Basis.singleton PUnit K + | D :: Ds, hDs => by + letI : Module K (OreTower (D :: Ds) hDs) := + towerKModule (D :: Ds) hDs + let T := build Ds hDs.2 + let hD : CommutesWith D Ds := pairwise_head hDs + let φ : K →+* T.carrier := towerCoefficient Ds hDs.2 + let ψ : K →+* NormalOre (T.extend D hD) := + (normalCoefficient (T.extend D hD)).comp φ + letI : Module K T.carrier := towerKModule Ds hDs.2 + letI : Module K (NormalOre (T.extend D hD)) := + towerKModule (D :: Ds) hDs + let b : Basis (exponentIndex Ds) K T.carrier := + towerPBWBasis Ds hDs.2 + let pb : Basis (ℕ × exponentIndex Ds) K (Polynomial T.carrier) := + polynomialBasis (K := K) T.carrier b + exact (pb.map (normalFormLinearEquivK (K := K) + (T.extend D hD) φ ψ rfl (by intro c r; rfl) (by intro c z; rfl))) + + +end +end AlgebraicAnalysis.OreIteratedPBW diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/IteratedTower.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/IteratedTower.lean new file mode 100644 index 0000000000..4845fa2f02 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/IteratedTower.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Tower + + +/-! +# Finite iterated derivation-Ore towers + +For a finite list of pairwise commuting coefficient derivations, this file +builds the corresponding iterated normal Ore ring. The construction stores, +at every stage, the lift of every further commuting derivation and the proof +that such lifts commute. Thus the construction can be iterated without any +new compatibility postulate. + +The final result is an additive iterated normal-form equivalence. Operator +faithfulness and freeness over a rational Weyl subring are deliberately not +asserted here. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.OreIteratedTower + +open Polynomial +open AlgebraicAnalysis +open AlgebraicAnalysis.OreDivision +open AlgebraicAnalysis.OreAssociativity +open AlgebraicAnalysis.OreTower + +noncomputable section + + +universe u + +variable {B : Type u} [Ring B] + +/-- A derivation used to build one stage of an iterated Ore tower. -/ +abbrev Derivation (B : Type u) [Ring B] := OreDivisionDerivation B + +/-- Commutation of two coefficient derivations. -/ +def Commutes (D E : Derivation B) : Prop := + ∀ b : B, D (E b) = E (D b) + +/-- Pairwise commutation for a finite ordered family. -/ +def PairwiseCommutes : List (Derivation B) → Prop + | [] => True + | D :: Ds => + (∀ E ∈ Ds, Commutes D E) ∧ PairwiseCommutes Ds + +/-- Commutation of one derivation with every member of a list. -/ +def CommutesWith (D : Derivation B) : List (Derivation B) → Prop + | Es => ∀ E ∈ Es, Commutes D E + +lemma commutes_symm {D E : Derivation B} (h : Commutes D E) : + Commutes E D := by + intro b + exact (h b).symm + +lemma pairwise_tail {D : Derivation B} {Ds : List (Derivation B)} + (h : PairwiseCommutes (D :: Ds)) : PairwiseCommutes Ds := + h.2 + +lemma pairwise_head {D : Derivation B} {Ds : List (Derivation B)} + (h : PairwiseCommutes (D :: Ds)) : CommutesWith D Ds := by + exact h.1 + +lemma commutesWith_tail {D E : Derivation B} {Es : List (Derivation B)} + (h : CommutesWith D (E :: Es)) : CommutesWith D Es := + fun F hF => h F (by simp [hF]) + +lemma commutes_refl (D : Derivation B) : Commutes D D := by + intro b + rfl + +/-! ## A recursive tower bundle -/ + +/-- +`TowerBuild Ds h` contains the carrier ring for the tower on `Ds`, together +with the lift of any derivation commuting with `Ds`. Bundling the lifts and +their commutation proof avoids a circular definition of the tower type. +-/ +structure TowerBuild (Ds : List (Derivation B)) + (hDs : PairwiseCommutes Ds) where + /-- The carrier type of the recursively built tower. -/ + carrier : Type u + /-- The ring structure on the tower carrier. -/ + ring : Ring carrier + /-- Extend a commuting coefficient derivation through the tower. -/ + extend : ∀ (D : Derivation B), CommutesWith D Ds → + OreDivisionDerivation carrier + extend_commutes : ∀ (D E : Derivation B) + (hD : CommutesWith D Ds) (hE : CommutesWith E Ds), Commutes D E → + Commutes (B := carrier) (extend D hD) (extend E hE) + +/-- Recursively construct the finite commuting derivation-Ore tower. -/ +def build : (Ds : List (Derivation B)) → + (hDs : PairwiseCommutes Ds) → TowerBuild Ds hDs + | [], _ => + { carrier := B + ring := inferInstance + extend := fun D _ => D + extend_commutes := by + intro D E _ _ hDE + exact hDE } + | E :: Es, hDs => by + let T := build Es hDs.2 + letI : Ring T.carrier := T.ring + let hE : CommutesWith E Es := pairwise_head hDs + let DE : OreDivisionDerivation T.carrier := T.extend E hE + refine + { carrier := NormalOre DE + ring := inferInstance + extend := ?_ + extend_commutes := ?_ } + · intro D hD + exact liftDerivation DE (T.extend D (commutesWith_tail hD)) + (T.extend_commutes E D hE (commutesWith_tail hD) + (commutes_symm (hD E (by simp)))) + · intro D F hD hF hDF + exact liftDerivation_commute DE + (T.extend D (commutesWith_tail hD)) + (T.extend F (commutesWith_tail hF)) + (T.extend_commutes E D hE (commutesWith_tail hD) + (commutes_symm (hD E (by simp)))) + (T.extend_commutes E F hE (commutesWith_tail hF) + (commutes_symm (hF E (by simp)))) + (T.extend_commutes D F (commutesWith_tail hD) + (commutesWith_tail hF) hDF) + +/-- The carrier ring of the finite iterated tower. -/ +abbrev OreTower (Ds : List (Derivation B)) + (hDs : PairwiseCommutes Ds) : Type u := (build Ds hDs).carrier + +instance oreTowerRing (Ds : List (Derivation B)) + (hDs : PairwiseCommutes Ds) : Ring (OreTower Ds hDs) := + (build Ds hDs).ring + +/-- The recursively lifted version of a coefficient derivation. -/ +def extendThrough (D : Derivation B) (Ds : List (Derivation B)) + (hDs : PairwiseCommutes Ds) (hD : CommutesWith D Ds) : + OreDivisionDerivation (OreTower Ds hDs) := + (build Ds hDs).extend D hD + +theorem extendThrough_commutes (D E : Derivation B) + (Ds : List (Derivation B)) (hDs : PairwiseCommutes Ds) + (hD : CommutesWith D Ds) (hE : CommutesWith E Ds) + (hDE : Commutes D E) : + Commutes (extendThrough D Ds hDs hD) + (extendThrough E Ds hDs hE) := + (build Ds hDs).extend_commutes D E hD hE hDE + +/-! ## Iterated normal forms -/ + +/-- A nested polynomial carrier together with the ring instance it needs. -/ +structure PolynomialBuild (Ds : List (Derivation B)) where + /-- The nested polynomial carrier. -/ + carrier : Type u + /-- The ring structure on the nested polynomial carrier. -/ + ring : Ring carrier + +/-- Recursively construct the nested polynomial coefficient carrier. -/ +def polynomialBuild : (Ds : List (Derivation B)) → PolynomialBuild Ds + | [] => + { carrier := B + ring := inferInstance } + | _ :: Ds => by + let P := polynomialBuild Ds + letI : Ring P.carrier := P.ring + exact { carrier := Polynomial P.carrier + ring := inferInstance } + +/-- Nested coefficient-left polynomial data for the tower. -/ +abbrev iteratedPolynomial (Ds : List (Derivation B)) : Type u := + (polynomialBuild Ds).carrier + +instance iteratedPolynomialRing (Ds : List (Derivation B)) : + Ring (iteratedPolynomial Ds) := + (polynomialBuild Ds).ring + +/-- Additive equivalence between nested polynomial data and the Ore tower. -/ +def iteratedNormalForm : (Ds : List (Derivation B)) → + (hDs : PairwiseCommutes Ds) → + iteratedPolynomial Ds ≃+ OreTower Ds hDs + | [], _ => AddEquiv.refl B + | D :: Ds, hDs => by + let T := build Ds hDs.2 + let P := polynomialBuild Ds + letI : Ring P.carrier := P.ring + let hD : CommutesWith D Ds := pairwise_head hDs + let e : P.carrier ≃+ T.carrier := + iteratedNormalForm Ds hDs.2 + let pCoeff : AddMonoidAlgebra P.carrier ℕ ≃+ (ℕ →₀ P.carrier) := + AddMonoidAlgebra.coeffAddEquiv + let tCoeff : AddMonoidAlgebra T.carrier ℕ ≃+ (ℕ →₀ T.carrier) := + AddMonoidAlgebra.coeffAddEquiv + let ep : Polynomial P.carrier ≃+ + Polynomial T.carrier := + (Polynomial.toFinsuppIso P.carrier).toAddEquiv.trans + (pCoeff.trans + ((Finsupp.mapRange.addEquiv (ι := ℕ) e).trans + (tCoeff.symm.trans + (Polynomial.toFinsuppIso T.carrier).toAddEquiv.symm))) + exact ep.trans (normalFormAddEquiv (T.extend D hD)) + +theorem iteratedNormalForm_injective (Ds : List (Derivation B)) + (hDs : PairwiseCommutes Ds) : + Function.Injective (iteratedNormalForm Ds hDs) := + (iteratedNormalForm Ds hDs).injective + +theorem iteratedNormalForm_surjective (Ds : List (Derivation B)) + (hDs : PairwiseCommutes Ds) : + Function.Surjective (iteratedNormalForm Ds hDs) := + (iteratedNormalForm Ds hDs).surjective + + +end +end AlgebraicAnalysis.OreIteratedTower diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/LeftPBW.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/LeftPBW.lean new file mode 100644 index 0000000000..5148ee454e --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/LeftPBW.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Associativity +public import Mathlib.Algebra.Polynomial.Basis +public import Mathlib.LinearAlgebra.Basis.Basic + + +/-! +# Left PBW basis for a derivation Ore extension + +The normal-form Ore +ring is a left module over its coefficient field even when the derivation is +nonzero (and hence the coefficient field is not central). Transporting the +ordinary polynomial monomial basis across the checked normal-form equivalence +gives the expected basis `1, ∂, ∂², ...`. + +The iterated tower still needs the commuting derivations to be extended over +earlier stages. Nothing in this file postulates such extensions. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.OreLeftPBW + +open Polynomial +open Module +open AlgebraicAnalysis +open AlgebraicAnalysis.OreDivision +open AlgebraicAnalysis.OreAssociativity + +noncomputable section + + +variable {K : Type*} [Field K] + +/-- The coefficient field acts on an Ore extension by multiplication on the +left through the canonical coefficient embedding. Centrality is neither +assumed nor needed. -/ +instance normalOreLeftModule (D : OreDivisionDerivation K) : + Module K (NormalOre D) := + Module.compHom (NormalOre D) (normalCoefficient D) + +theorem normalForm_smul_left (D : OreDivisionDerivation K) + (c : K) (p : Polynomial K) : + normalForm D (c • p) = c • normalForm D p := by + induction p using Polynomial.induction_on' with + | add p q hp hq => + rw [smul_add, normalForm_add, normalForm_add, hp, hq, smul_add] + | monomial n b => + rw [Polynomial.smul_monomial, normalForm_monomial, + normalForm_monomial] + change normalCoefficient D (c * b) * normalVariable D ^ n = + normalCoefficient D c * + (normalCoefficient D b * normalVariable D ^ n) + rw [map_mul, mul_assoc] + +/-- Coefficient-left Ore normal form as a linear equivalence over the +coefficient field. -/ +def leftNormalFormLinearEquiv (D : OreDivisionDerivation K) : + Polynomial K ≃ₗ[K] NormalOre D := + { normalFormAddEquiv D with + map_smul' := normalForm_smul_left D } + +@[simp] +theorem leftNormalFormLinearEquiv_apply + (D : OreDivisionDerivation K) (p : Polynomial K) : + leftNormalFormLinearEquiv D p = normalForm D p := rfl + +/-- The powers of the Ore variable form a left basis over the coefficient +field. -/ +def orePBWBasis (D : OreDivisionDerivation K) : Basis ℕ K (NormalOre D) := + (Polynomial.basisMonomials K).map (leftNormalFormLinearEquiv D) + +@[simp] +theorem orePBWBasis_apply (D : OreDivisionDerivation K) (n : ℕ) : + orePBWBasis D n = normalVariable D ^ n := by + rw [orePBWBasis, Basis.map_apply, Polynomial.coe_basisMonomials] + change normalForm D (Polynomial.monomial n 1) = normalVariable D ^ n + rw [normalForm_monomial, map_one, one_mul] + +/-- Every element has a unique finite coefficient-left expansion in powers +of the Ore variable. -/ +theorem orePBW_repr_symm_single (D : OreDivisionDerivation K) + (n : ℕ) (c : K) : + (orePBWBasis D).repr.symm (Finsupp.single n c) = + normalCoefficient D c * normalVariable D ^ n := by + rw [(orePBWBasis D).repr_symm_single, orePBWBasis_apply] + rfl + + +end +end AlgebraicAnalysis.OreLeftPBW diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/Localization.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/Localization.lean new file mode 100644 index 0000000000..909fb918d4 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/Localization.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.OreLocalization.Ring + + +/-! +# Generic Ore-localization facts + +This file records unconditional fraction and denominator results used by a +stage argument. The common-denominator lemma is proved directly from the +Ore condition. No flatness, Noetherianity, or freeness of a localized ring +over a stage ring is assumed. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis +namespace OreStageLocalization + +open OreLocalization +open nonZeroDivisors + +universe u + +section CommonDenominators + +variable {R : Type u} [Monoid R] +variable {S : Submonoid R} [OreSet S] + +/-- A finite family of Ore denominators has a common left multiple. -/ +theorem exists_common_left_multiple (s : Finset S) : + ∃ t : S, ∀ a ∈ s, ∃ u : R, (t : R) = u * (a : R) := by + classical + induction s using Finset.induction_on with + | empty => + refine ⟨1, ?_⟩ + simp + | @insert a s ha ih => + rcases ih with ⟨t, ht⟩ + rcases oreCondition (t : R) a with ⟨u, v, huv⟩ + refine ⟨v * t, ?_⟩ + intro b hb + rcases Finset.mem_insert.mp hb with rfl | hb + · exact ⟨u, huv⟩ + · rcases ht b hb with ⟨w, hw⟩ + refine ⟨(v : R) * w, ?_⟩ + simp [Submonoid.coe_mul, hw, mul_assoc] + +end CommonDenominators + +section FractionRepresentation + +variable {R : Type u} [Ring R] [Nontrivial R] [NoZeroDivisors R] +variable {S : Submonoid R} [OreSet S] + +omit [Nontrivial R] [NoZeroDivisors R] in +/-- Every element of an Ore localization has an explicit numerator/denominator form. -/ +theorem exists_fraction (x : R[S⁻¹]) : + ∃ r : R, ∃ s : S, x = r /ₒ s := by + induction x using OreLocalization.ind with + | _ r s => exact ⟨r, s, rfl⟩ + +omit [Nontrivial R] [NoZeroDivisors R] in +/-- A nonzero localized element has a representative with nonzero numerator. -/ +theorem exists_ne_zero_numerator {x : R[S⁻¹]} (hx : x ≠ 0) : + ∃ r : R, r ≠ 0 ∧ ∃ s : S, x = r /ₒ s := by + induction x using OreLocalization.ind with + | _ r s => + refine ⟨r, ?_, s, rfl⟩ + intro hr + apply hx + subst r + exact OreLocalization.zero_oreDiv' s + +/-- Under a right non-zero-divisor hypothesis, the numerator embedding is injective. -/ +theorem numerator_injective (hS : S ≤ nonZeroDivisorsRight R) : + Function.Injective (OreLocalization.numeratorHom : R → R[S⁻¹]) := + OreLocalization.numeratorHom_inj <| by + intro s hs + rw [mem_nonZeroDivisorsLeft_iff] + intro y hsy + have hs0 : (s : R) ≠ 0 := by + intro hs0 + have h1 : (1 : R) = 0 := hS hs 1 (by simp [hs0]) + exact one_ne_zero h1 + exact (mul_eq_zero.mp hsy).resolve_left hs0 + +omit [Nontrivial R] [NoZeroDivisors R] in +/-- Every chosen denominator becomes a unit in an Ore localization. -/ +theorem denominator_isUnit (s : S) : + IsUnit (OreLocalization.numeratorHom (s : R) : R[S⁻¹]) := + OreLocalization.numerator_isUnit s + +end FractionRepresentation + +section FullFractionRing + +variable {R : Type u} [Ring R] [Nontrivial R] [NoZeroDivisors R] +variable [OreLocalization.OreSet R⁰] + +/-- Every nonzero numerator is a unit in the full Ore division-ring localization. -/ +theorem nonzero_numerator_isUnit {r : R} (hr : r ≠ 0) : + IsUnit (OreLocalization.numeratorHom r : R[R⁰⁻¹]) := by + simpa using + (OreLocalization.numerator_isUnit + (⟨r, mem_nonZeroDivisors_of_ne_zero hr⟩ : R⁰)) + +/-- Every nonzero element of the full Ore localization is a unit. -/ +theorem full_isUnit_of_ne_zero {x : R[R⁰⁻¹]} (hx : x ≠ 0) : IsUnit x := + isUnit_iff_ne_zero.mpr hx + +end FullFractionRing + + +end OreStageLocalization +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/LocalizationExtension.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/LocalizationExtension.lean new file mode 100644 index 0000000000..38f2aa35b7 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/LocalizationExtension.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Associativity +public import Mathlib.RingTheory.OreLocalization.Ring + + +/-! +# Localization interface for derivation-Ore extensions + +The proposition below is the exact output expected from a theorem saying that +localizing a derivation-Ore extension at coefficients gives the derivation-Ore +extension of the localized coefficient ring. It packages data and its +compatibility law; it does not assert that the data exist. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis +namespace OreLocalizationExtension + +open AlgebraicAnalysis.OreDivision +open AlgebraicAnalysis.OreAssociativity +open OreLocalization + +/-- Existence of data identifying the localization of `NormalOre D` along coefficient +denominators with a derivation-Ore extension of the localized coefficient +ring. Ore-ness of both denominator sets remains an explicit hypothesis. -/ +def IsDerivationOreLocalization + {B : Type*} [Ring B] + (D : OreDivisionDerivation B) (S : Submonoid B) + [OreSet S] + [OreSet (S.map (normalCoefficient D).toMonoidHom)] : Prop := + ∃ (D' : OreDivisionDerivation (B[S⁻¹])) + (e : (NormalOre D)[(S.map (normalCoefficient D).toMonoidHom)⁻¹] ≃+* + NormalOre D'), + ∀ b : B, + e (numeratorHom (normalCoefficient D b)) = + normalCoefficient D' (numeratorHom b) + +end OreLocalizationExtension +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/PrincipalRightIdeal.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/PrincipalRightIdeal.lean new file mode 100644 index 0000000000..d4dc394991 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/PrincipalRightIdeal.lean @@ -0,0 +1,358 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightQuotient + + +/-! +# Principal right ideals in a derivation Ore normal form + +This module isolates the generic minimal-degree and right-principal-ideal +arguments for a derivation Ore extension over a division ring. The +coefficient ring may be noncommutative. The right-sided orientation is +explicit: division has the divisor on the left and the quotient on the right. + +No simplicity, localization, or left-PID statement is asserted here. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.OrePrincipalRightIdeal + +open Polynomial +open AlgebraicAnalysis +open AlgebraicAnalysis.OreDivision +open AlgebraicAnalysis.OreAssociativity + +noncomputable section + +variable {B : Type*} [DivisionRing B] + +lemma rightMul_C_left (D : OreDivisionDerivation B) (c : B) (p : Polynomial B) : + OreDivision.rightMul D (Polynomial.C c) p = Polynomial.C c * p := by + apply Polynomial.ext + intro n + rw [OreDivision.rightMul, Polynomial.coeff_sum] + rw [Polynomial.sum_def] + by_cases hc : c = 0 + · subst c + simp [OreDivision.rightMulMonomial_coeff] + · simp only [OreDivision.rightMulMonomial_coeff] + rw [Polynomial.support_C hc] + simp [hc] + +lemma rightMul_coeff_C_top (D : OreDivisionDerivation B) (p : Polynomial B) + (b : B) (hp : p ≠ 0) : + (OreDivision.rightMul D p (Polynomial.C b)).coeff p.natDegree = + p.leadingCoeff * b := by + rw [OreDivision.rightMul, Polynomial.coeff_sum] + rw [Polynomial.sum_def] + by_cases hb : b = 0 + · subst b + simp + · rw [Polynomial.support_C hb] + simp only [Finset.sum_singleton, coeff_C_zero] + exact OreDivision.rightMulMonomial_coeff_top D p hp b 0 + +lemma degree_lt_of_degree_le_of_coeff_zero + (p : Polynomial B) (n : ℕ) (hdeg : p.degree ≤ (n : WithBot ℕ)) + (hcoef : p.coeff n = 0) : + p.degree < (n : WithBot ℕ) := by + rw [Polynomial.degree_lt_iff_coeff_zero] + intro m hnm + by_cases hmn : m = n + · simpa [hmn] using hcoef + · have hnm' : n < m := lt_of_le_of_ne hnm (Ne.symm hmn) + apply Polynomial.coeff_eq_zero_of_degree_lt + exact lt_of_le_of_lt hdeg (WithBot.coe_lt_coe.mpr hnm') + +/-- A monic minimum-degree member of a two-sided ideal commutes with every +coefficient. This is a minimal-degree reduction, not a simplicity theorem. -/ +theorem minimal_monic_member_commutes_coefficients + (D : OreDivisionDerivation B) (I : TwoSidedIdeal (NormalOre D)) + (p : Polynomial B) (hp : p.Monic) (hpI : normalForm D p ∈ I) + (hmin : ∀ q : Polynomial B, q ≠ 0 → normalForm D q ∈ I → + p.natDegree ≤ q.natDegree) (b : B) : + OreDivision.rightMul D p (Polynomial.C b) = + OreDivision.rightMul D (Polynomial.C b) p := by + let q := OreDivision.rightMul D p (Polynomial.C b) - + OreDivision.rightMul D (Polynomial.C b) p + have hqI : normalForm D q ∈ I := by + have hright : normalForm D (OreDivision.rightMul D p (Polynomial.C b)) ∈ I := by + rw [normalForm_mul] + exact I.mul_mem_right _ _ hpI + have hleft : normalForm D (OreDivision.rightMul D (Polynomial.C b) p) ∈ I := by + rw [normalForm_mul] + exact I.mul_mem_left _ _ hpI + change normalForm D + (OreDivision.rightMul D p (Polynomial.C b) + + -OreDivision.rightMul D (Polynomial.C b) p) ∈ I + rw [normalForm_add, normalForm_neg] + exact I.sub_mem hright hleft + have hqdeg : q.degree ≤ (p.natDegree : WithBot ℕ) := by + apply le_trans (degree_sub_le _ _) + apply max_le + · have h := OreDivision.rightMul_degree_le D p (Polynomial.C b) + simpa using h + · have h := OreDivision.rightMul_degree_le D (Polynomial.C b) p + simpa using h + have hqcoef : q.coeff p.natDegree = 0 := by + dsimp [q] + rw [Polynomial.coeff_sub, rightMul_coeff_C_top D p b hp.ne_zero, + rightMul_C_left] + rw [Polynomial.coeff_C_mul] + simp [hp.leadingCoeff] + have hqlt : q.degree < (p.natDegree : WithBot ℕ) := + degree_lt_of_degree_le_of_coeff_zero q p.natDegree hqdeg hqcoef + by_cases hq0 : q = 0 + · exact sub_eq_zero.mp hq0 + · have hnat : p.natDegree ≤ q.natDegree := hmin q hq0 hqI + have hqdeg' : q.degree = (q.natDegree : WithBot ℕ) := + Polynomial.degree_eq_natDegree hq0 + rw [hqdeg'] at hqlt + have hltNat : q.natDegree < p.natDegree := WithBot.coe_lt_coe.mp hqlt + exact False.elim ((not_le_of_gt hltNat) hnat) + +/-- Every nonzero two-sided ideal has a monic member of minimum normal-form +degree. The leading coefficient is normalized within the ideal. -/ +theorem exists_monic_minimal_member + (D : OreDivisionDerivation B) (I : TwoSidedIdeal (NormalOre D)) + (hI : ∃ z : NormalOre D, z ∈ I ∧ z ≠ 0) : + ∃ p : Polynomial B, p.Monic ∧ normalForm D p ∈ I ∧ + ∀ q : Polynomial B, q ≠ 0 → normalForm D q ∈ I → + p.natDegree ≤ q.natDegree := by + classical + obtain ⟨z, hzI, hz0⟩ := hI + obtain ⟨p, rfl⟩ := normalForm_surjective D z + have hp0 : p ≠ 0 := by + intro hp + apply hz0 + simp [hp] + let P : ℕ → Prop := fun n => ∃ q : Polynomial B, + q ≠ 0 ∧ normalForm D q ∈ I ∧ q.natDegree = n + have hex : ∃ n, P n := ⟨p.natDegree, p, hp0, hzI, rfl⟩ + let n : ℕ := Nat.find hex + obtain ⟨p₀, hp₀0, hp₀I, hp₀deg⟩ := Nat.find_spec hex + let c : B := p₀.leadingCoeff⁻¹ + let p' : Polynomial B := Polynomial.C c * p₀ + have hc : c ≠ 0 := by + dsimp [c] + exact inv_ne_zero (Polynomial.leadingCoeff_ne_zero.mpr hp₀0) + have hp'0 : p' ≠ 0 := by + dsimp [p'] + exact mul_ne_zero (Polynomial.C_ne_zero.mpr hc) hp₀0 + have hnat : p'.natDegree = p₀.natDegree := by + have hdeg : p'.degree = p₀.degree := by + dsimp [p'] + exact Polynomial.degree_C_mul hc + rw [Polynomial.degree_eq_natDegree hp'0, + Polynomial.degree_eq_natDegree hp₀0] at hdeg + exact WithBot.coe_eq_coe.mp hdeg + have hp'I : normalForm D p' ∈ I := by + dsimp [p'] + rw [← rightMul_C_left] + rw [normalForm_mul] + exact I.mul_mem_left _ _ hp₀I + have hp'Monic : p'.Monic := by + change p'.leadingCoeff = 1 + change p'.coeff p'.natDegree = 1 + rw [hnat, + Polynomial.coeff_C_mul, Polynomial.coeff_natDegree] + dsimp [c] + exact inv_mul_cancel₀ (Polynomial.leadingCoeff_ne_zero.mpr hp₀0) + refine ⟨p', hp'Monic, hp'I, ?_⟩ + intro q hq hqI + have hqn : P q.natDegree := ⟨q, hq, hqI, rfl⟩ + have hnle : n ≤ q.natDegree := Nat.find_min' hex hqn + calc + p'.natDegree = p₀.natDegree := hnat + _ = n := hp₀deg + _ ≤ q.natDegree := hnle + +/-! +The remaining declarations are the right-sided Euclidean/PID stage for a +normal-form differential Ore extension. They use the same leading-term +argument and make no claim about left ideals. +-/ + +/-- The right ideal generated by a normal-form polynomial. -/ +def normalOrePrincipalRightIdeal (D : OreDivisionDerivation B) (p : Polynomial B) : + Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D) := + Submodule.span (NormalOre D)ᵐᵒᵖ ({normalForm D p} : Set (NormalOre D)) + +/-- The right ideal generated by an arbitrary element of `NormalOre D`. -/ +def normalOrePrincipalRightIdealElement (D : OreDivisionDerivation B) + (a : NormalOre D) : + Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D) := + Submodule.span (NormalOre D)ᵐᵒᵖ ({a} : Set (NormalOre D)) + +/-- Right Euclidean division transported from polynomial normal form. -/ +theorem normalOre_right_division + (D : OreDivisionDerivation B) (d : Polynomial B) (hd : d.Monic) + (a : NormalOre D) : + ∃ q r : Polynomial B, + a = normalForm D (OreDivision.rightMul D d q) + normalForm D r ∧ + (r = 0 ∨ r.natDegree < d.natDegree) := by + obtain ⟨p, rfl⟩ := normalForm_surjective D a + obtain ⟨q, r, hdiv, hrem⟩ := right_division_exists D d p hd + refine ⟨q, r, ?_, hrem⟩ + rw [hdiv, normalForm_add] + +lemma rightMul_C_degree_eq (D : OreDivisionDerivation B) (p : Polynomial B) + (c : B) (hp : p ≠ 0) (hc : c ≠ 0) : + (OreDivision.rightMul D p (Polynomial.C c)).degree = p.degree := by + have hle := OreDivision.rightMul_degree_le D p (Polynomial.C c) + have hle' : (OreDivision.rightMul D p (Polynomial.C c)).degree ≤ + (p.natDegree : WithBot ℕ) := by simpa using hle + have htop : (OreDivision.rightMul D p (Polynomial.C c)).coeff p.natDegree = + p.leadingCoeff * c := by + exact rightMul_coeff_C_top D p c hp + have htop0 : (OreDivision.rightMul D p (Polynomial.C c)).coeff p.natDegree ≠ 0 := by + rw [htop] + exact mul_ne_zero (Polynomial.leadingCoeff_ne_zero.mpr hp) hc + have hge : (p.natDegree : WithBot ℕ) ≤ + (OreDivision.rightMul D p (Polynomial.C c)).degree := by + by_contra hnot + have hlt : (OreDivision.rightMul D p (Polynomial.C c)).degree < + (p.natDegree : WithBot ℕ) := lt_of_not_ge hnot + exact htop0 (Polynomial.coeff_eq_zero_of_degree_lt hlt) + rw [Polynomial.degree_eq_natDegree hp] + exact le_antisymm hle' hge + +/-- A nonzero right submodule has a monic member of minimum normal-form +degree. Normalization uses right multiplication by the inverse coefficient. -/ +theorem exists_monic_minimal_right_member + (D : OreDivisionDerivation B) + (I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D)) + (hI : ∃ z : NormalOre D, z ∈ I ∧ z ≠ 0) : + ∃ p : Polynomial B, p.Monic ∧ normalForm D p ∈ I ∧ + ∀ q : Polynomial B, q ≠ 0 → normalForm D q ∈ I → + p.natDegree ≤ q.natDegree := by + classical + obtain ⟨z, hzI, hz0⟩ := hI + obtain ⟨p, rfl⟩ := normalForm_surjective D z + have hp0 : p ≠ 0 := by + intro hp + apply hz0 + simp [hp] + let P : ℕ → Prop := fun n => ∃ q : Polynomial B, + q ≠ 0 ∧ normalForm D q ∈ I ∧ q.natDegree = n + have hex : ∃ n, P n := ⟨p.natDegree, p, hp0, hzI, rfl⟩ + let n : ℕ := Nat.find hex + obtain ⟨p₀, hp₀0, hp₀I, hp₀deg⟩ := Nat.find_spec hex + let c : B := p₀.leadingCoeff⁻¹ + let p' : Polynomial B := OreDivision.rightMul D p₀ (Polynomial.C c) + have hc : c ≠ 0 := by + dsimp [c] + exact inv_ne_zero (Polynomial.leadingCoeff_ne_zero.mpr hp₀0) + have hp'0 : p' ≠ 0 := by + intro hz + have hz' := congrArg (fun z : Polynomial B => z.coeff p₀.natDegree) hz + change (OreDivision.rightMul D p₀ (Polynomial.C c)).coeff p₀.natDegree = 0 at hz' + rw [rightMul_coeff_C_top D p₀ c hp₀0] at hz' + exact (mul_ne_zero (Polynomial.leadingCoeff_ne_zero.mpr hp₀0) hc) hz' + have hdeg : p'.degree = p₀.degree := by + dsimp [p'] + exact rightMul_C_degree_eq D p₀ c hp₀0 hc + have hnat : p'.natDegree = p₀.natDegree := by + rw [Polynomial.degree_eq_natDegree hp'0, + Polynomial.degree_eq_natDegree hp₀0] at hdeg + exact WithBot.coe_eq_coe.mp hdeg + have hp'I : normalForm D p' ∈ I := by + dsimp [p'] + rw [normalForm_mul] + rw [← op_smul_eq_mul] + exact I.smul_mem (MulOpposite.op (normalForm D (Polynomial.C c))) hp₀I + have hp'Monic : p'.Monic := by + change p'.leadingCoeff = 1 + change p'.coeff p'.natDegree = 1 + have htop := rightMul_coeff_C_top D p₀ c hp₀0 + rw [hnat] + dsimp [p'] + rw [htop] + dsimp [c] + exact mul_inv_cancel₀ (Polynomial.leadingCoeff_ne_zero.mpr hp₀0) + refine ⟨p', hp'Monic, hp'I, ?_⟩ + intro q hq hqI + have hqn : P q.natDegree := ⟨q, hq, hqI, rfl⟩ + have hnle : n ≤ q.natDegree := Nat.find_min' hex hqn + calc + p'.natDegree = p₀.natDegree := hnat + _ = n := hp₀deg + _ ≤ q.natDegree := hnle + +/-- Every nonzero right ideal is generated by one monic normal-form element. +The ideal equality is on the right: `I = p (NormalOre D)`. -/ +theorem rightIdeal_eq_principal_of_nonzero + (D : OreDivisionDerivation B) + (I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D)) + (hI : ∃ z : NormalOre D, z ∈ I ∧ z ≠ 0) : + ∃ p : Polynomial B, p.Monic ∧ + I = normalOrePrincipalRightIdeal D p := by + obtain ⟨p, hp, hpI, hmin⟩ := exists_monic_minimal_right_member D I hI + refine ⟨p, hp, ?_⟩ + apply le_antisymm + · intro z hz + change z ∈ Submodule.span (NormalOre D)ᵐᵒᵖ + ({normalForm D p} : Set (NormalOre D)) + obtain ⟨q, rfl⟩ := normalForm_surjective D z + obtain ⟨u, r, hdecomp, hrem⟩ := right_division_exists D p q hp + have hprod : normalForm D (OreDivision.rightMul D p u) ∈ I := by + rw [normalForm_mul] + rw [← op_smul_eq_mul] + exact I.smul_mem (MulOpposite.op (normalForm D u)) hpI + have hrI : normalForm D r ∈ I := by + have hqeq : normalForm D q = + normalForm D (OreDivision.rightMul D p u) + normalForm D r := by + rw [← normalForm_add, ← hdecomp] + have hsub := I.sub_mem hz hprod + rw [hqeq] at hsub + simpa using hsub + have hr0 : r = 0 := by + by_cases hr : r = 0 + · exact hr + · have hlt := hrem.resolve_left hr + have hcontr := hmin r hr hrI + exact False.elim ((Nat.not_lt_of_ge hcontr) hlt) + subst r + rw [hdecomp, add_zero, normalForm_mul] + rw [← op_smul_eq_mul] + exact Submodule.smul_mem _ _ (Submodule.subset_span (by simp)) + · apply Submodule.span_le.2 + intro z hz + rcases Set.mem_singleton_iff.mp hz with rfl + exact hpI + +/-- Every right ideal of `NormalOre D` is principal, including the zero ideal. +This is a one-sided PID statement; no left-PID claim is made. -/ +theorem rightIdeal_isPrincipal + (D : OreDivisionDerivation B) + (I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D)) : + ∃ a : NormalOre D, I = normalOrePrincipalRightIdealElement D a := by + by_cases hI : ∃ z : NormalOre D, z ∈ I ∧ z ≠ 0 + · obtain ⟨p, hp, hEq⟩ := rightIdeal_eq_principal_of_nonzero D I hI + exact ⟨normalForm D p, hEq⟩ + · have hbot : I = ⊥ := by + apply le_antisymm + · intro z hz + by_contra hz0 + exact hI ⟨z, hz, hz0⟩ + · exact bot_le + have hzero : normalOrePrincipalRightIdealElement D (0 : NormalOre D) = ⊥ := by + apply le_antisymm + · apply Submodule.span_le.2 + intro z hz + simpa using hz + · exact bot_le + refine ⟨0, ?_⟩ + rw [hbot, hzero] + + +end + +end AlgebraicAnalysis.OrePrincipalRightIdeal diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightDivision.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightDivision.lean new file mode 100644 index 0000000000..58d34865eb --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightDivision.lean @@ -0,0 +1,1247 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Algebra.Basic +public import Mathlib.Algebra.Polynomial.Degree.Support +public import Mathlib.LinearAlgebra.Quotient.Defs +public import Mathlib.Tactic +public import Mathlib.Tactic.Abel + + +/-! +# Right division in a coefficient-left derivation Ore model + +This file is the next structural layer after `ore_derivation.lean`. It does +not identify a presented Weyl algebra with this model. It builds the finite +normal-form algebra needed for that identification: the normal form of +`x^i * b`, the right product of a normal polynomial by a monomial `b*x^j`, +and the leading-term fact which drives right division by a monic polynomial. + +The coefficient ring is allowed to be noncommutative. No commutative +polynomial division theorem is used. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis + +noncomputable section + +/-- A derivation used to define a coefficient-left Ore normal form. -/ +structure OreDivisionDerivation (B : Type*) [Ring B] where + /-- The underlying additive derivation map. -/ + toFun : B → B + /-- The derivation preserves zero. -/ + map_zero' : toFun 0 = 0 + /-- The derivation preserves addition. -/ + map_add' : ∀ a b, toFun (a + b) = toFun a + toFun b + /-- The Leibniz rule. -/ + leibniz' : ∀ a b, toFun (a * b) = a * toFun b + toFun a * b + +instance {B : Type*} [Ring B] : CoeFun (OreDivisionDerivation B) (fun _ => B → B) := + ⟨OreDivisionDerivation.toFun⟩ + +namespace OreDivisionDerivation + +variable {B : Type*} [Ring B] (D : OreDivisionDerivation B) + +@[simp] +theorem map_zero : D 0 = 0 := D.map_zero' + +@[simp] +theorem map_add (a b : B) : D (a + b) = D a + D b := D.map_add' a b + +@[simp] +theorem leibniz (a b : B) : D (a * b) = a * D b + D a * b := D.leibniz' a b + +lemma map_nsmul (a : B) (n : ℕ) : D (n • a) = n • D a := by + induction n with + | zero => simp + | succ n ih => simp only [succ_nsmul, map_add, ih] + +end OreDivisionDerivation + +namespace OreDivision + +variable {B : Type*} [Ring B] (D : OreDivisionDerivation B) + +/-- The coefficient-left normal form of `x^i*b` under `x*b=b*x+D(b)`. -/ +def push (b : B) (i : ℕ) : Polynomial B := + ∑ k ∈ Finset.range (i + 1), + Polynomial.monomial (i - k) (Nat.choose i k • (D^[k]) b) + +lemma push_coeff (b : B) (i n : ℕ) : + (OreDivision.push D b i).coeff n = + ∑ k ∈ Finset.range (i + 1), + if i - k = n then Nat.choose i k • (D^[k]) b else 0 := by + simp [push, Polynomial.coeff_monomial] + +lemma push_degree_le (b : B) (i : ℕ) : (OreDivision.push D b i).degree ≤ (i : WithBot ℕ) := by + rw [Polynomial.degree_le_iff_coeff_zero] + intro n hn + rw [push_coeff] + apply Finset.sum_eq_zero + intro k hk + by_cases hki : i - k = n + · have hn' : i < n := by exact_mod_cast hn + have hle : i - k ≤ i := Nat.sub_le _ _ + omega + · simp [hki] + +lemma push_coeff_top (b : B) (i : ℕ) : (OreDivision.push D b i).coeff i = b := by + rw [push_coeff] + rw [Finset.sum_eq_single 0 (by + intro k hk hk0 + have hkpos : 0 < k := Nat.pos_of_ne_zero hk0 + have hk_lt : k < i + 1 := Finset.mem_range.mp hk + have hk_le : k ≤ i := by omega + have hi_pos : 0 < i := lt_of_lt_of_le hkpos hk_le + have hki : i - k ≠ i := Nat.ne_of_lt (Nat.sub_lt hi_pos hkpos) + simp [hki]) (by simp)] + simp + +lemma push_eq_zero_of (b : B) (i : ℕ) (h : b = 0) : OreDivision.push D b i = 0 := by + subst b + have hiter : ∀ n : ℕ, (D^[n]) 0 = 0 := by + intro n + induction n with + | zero => simp + | succ n ih => + rw [Function.iterate_succ_apply'] + simp [ih, OreDivisionDerivation.map_zero] + simp [push, hiter] + +/-- Right multiplication of a normal polynomial by the monomial `b*x^j`. + +The definition is coefficientwise and finite. It is deliberately not the +ordinary multiplication of `Polynomial B`: the inner `push` expansion is the +derivation correction for moving `b` through powers of `x`. +-/ +def rightTerm (i : ℕ) (a b : B) (j : ℕ) : Polynomial B := + ∑ k ∈ Finset.range (i + 1), + Polynomial.monomial (i - k + j) + (a * (Nat.choose i k • (D^[k]) b)) + +/-- Right multiplication by one coefficient-monomial. -/ +def rightMulMonomial (p : Polynomial B) (b : B) (j : ℕ) : Polynomial B := + p.sum (fun i a => rightTerm D i a b j) + +lemma rightMulMonomial_coeff (p : Polynomial B) (b : B) (j n : ℕ) : + (rightMulMonomial D p b j).coeff n = + ∑ i ∈ p.support, ∑ k ∈ Finset.range (i + 1), + if i - k + j = n then + p.coeff i * (Nat.choose i k • (D^[k]) b) else 0 := by + simp [rightMulMonomial, rightTerm, + Polynomial.coeff_monomial, Polynomial.sum_def] + +lemma rightTerm_zero (i : ℕ) (b : B) (j : ℕ) : rightTerm D i 0 b j = 0 := by + simp [rightTerm] + +lemma rightTerm_add_left (i : ℕ) (a₁ a₂ b : B) (j : ℕ) : + rightTerm D i (a₁ + a₂) b j = + rightTerm D i a₁ b j + rightTerm D i a₂ b j := by + simp only [rightTerm, add_mul] + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro k hk + rw [map_add] + +lemma rightMulMonomial_add_left (p q : Polynomial B) (b : B) (j : ℕ) : + rightMulMonomial D (p + q) b j = + rightMulMonomial D p b j + rightMulMonomial D q b j := by + apply Polynomial.sum_add_index + · intro i + exact rightTerm_zero D i b j + · intro i a₁ a₂ + exact rightTerm_add_left D i a₁ a₂ b j + +lemma iterate_add (n : ℕ) (b₁ b₂ : B) : + (D^[n]) (b₁ + b₂) = (D^[n]) b₁ + (D^[n]) b₂ := by + induction n with + | zero => simp + | succ n ih => + calc + (D^[n + 1]) (b₁ + b₂) = D ((D^[n]) (b₁ + b₂)) := + Function.iterate_succ_apply' D n (b₁ + b₂) + _ = D ((D^[n]) b₁ + (D^[n]) b₂) := by rw [ih] + _ = D ((D^[n]) b₁) + D ((D^[n]) b₂) := D.map_add _ _ + _ = (D^[n + 1]) b₁ + (D^[n + 1]) b₂ := by + rw [Function.iterate_succ_apply', Function.iterate_succ_apply'] + +lemma iterate_zero (n : ℕ) : (D^[n]) 0 = 0 := by + induction n with + | zero => simp + | succ n ih => + calc + (D^[n + 1]) 0 = D ((D^[n]) 0) := Function.iterate_succ_apply' D n 0 + _ = D 0 := by rw [ih] + _ = 0 := D.map_zero + +lemma rightMulMonomial_add_right (p : Polynomial B) (b₁ b₂ : B) (j : ℕ) : + rightMulMonomial D p (b₁ + b₂) j = + rightMulMonomial D p b₁ j + rightMulMonomial D p b₂ j := by + apply Polynomial.ext + intro n + rw [rightMulMonomial_coeff, Polynomial.coeff_add, + rightMulMonomial_coeff, rightMulMonomial_coeff] + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro i hi + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro k hk + by_cases hEq : i - k + j = n + · simp only [ite_eq_left hEq, iterate_add, nsmul_add, mul_add] + · simp [hEq] + +lemma rightMulMonomial_zero_right (p : Polynomial B) (j : ℕ) : + rightMulMonomial D p 0 j = 0 := by + apply Polynomial.ext + intro n + rw [rightMulMonomial_coeff] + apply Finset.sum_eq_zero + intro i hi + apply Finset.sum_eq_zero + intro k hk + simp [iterate_zero] + +/-- The product `d*q` of a normal polynomial by a normal right quotient. -/ +def rightMul (d q : Polynomial B) : Polynomial B := + q.sum (fun j c => rightMulMonomial D d c j) + +lemma rightMul_add (d q₁ q₂ : Polynomial B) : + rightMul D d (q₁ + q₂) = rightMul D d q₁ + rightMul D d q₂ := by + apply Polynomial.sum_add_index + · intro j + exact rightMulMonomial_zero_right D d j + · intro j c₁ c₂ + exact rightMulMonomial_add_right D d c₁ c₂ j + +lemma rightMul_zero (d : Polynomial B) : rightMul D d 0 = 0 := by + simp [rightMul, Polynomial.sum_def] + +/-- The additive map given by right multiplication by a fixed normal form. -/ +def rightMulAddHom (d : Polynomial B) : Polynomial B →+ Polynomial B where + toFun := rightMul D d + map_zero' := rightMul_zero D d + map_add' := rightMul_add D d + +lemma rightMul_sub (d q₁ q₂ : Polynomial B) : + rightMul D d (q₁ - q₂) = rightMul D d q₁ - rightMul D d q₂ := by + exact map_sub (rightMulAddHom D d) q₁ q₂ + +lemma rightMul_monomial (d : Polynomial B) (c : B) (j : ℕ) : + rightMul D d (Polynomial.monomial j c) = + rightMulMonomial D d c j := by + by_cases hc : c = 0 + · subst c + simp [rightMul, Polynomial.sum_def, rightMulMonomial_zero_right] + · unfold rightMul + rw [Polynomial.sum_def, Polynomial.support_monomial j hc] + simp [Polynomial.coeff_monomial] + +lemma rightMulMonomial_degree_le (p : Polynomial B) (b : B) (j : ℕ) : + (rightMulMonomial D p b j).degree ≤ (p.natDegree + j : WithBot ℕ) := by + rw [Polynomial.degree_le_iff_coeff_zero] + intro n hn + rw [rightMulMonomial_coeff] + apply Finset.sum_eq_zero + intro i hi + apply Finset.sum_eq_zero + intro k hk + by_cases hEq : i - k + j = n + · have hn' : p.natDegree + j < n := by exact_mod_cast hn + have hi_le : i ≤ p.natDegree := Polynomial.le_natDegree_of_mem_supp i hi + have hle : i - k + j ≤ p.natDegree + j := by + omega + omega + · simp [hEq] + +lemma rightMulMonomial_coeff_top (p : Polynomial B) (hp : p ≠ 0) + (b : B) (j : ℕ) : + (rightMulMonomial D p b j).coeff (p.natDegree + j) = + p.leadingCoeff * b := by + rw [rightMulMonomial_coeff] + have htop : p.natDegree ∈ p.support := + Polynomial.natDegree_mem_support_of_nonzero hp + rw [Finset.sum_eq_single p.natDegree (by + intro i hi hne + apply Finset.sum_eq_zero + intro k hk + have hi_le : i ≤ p.natDegree := Polynomial.le_natDegree_of_mem_supp i hi + have hi_lt : i < p.natDegree := lt_of_le_of_ne hi_le hne + have hne_sub : i - k ≠ p.natDegree := by omega + simp [hne_sub]) (by simp [htop])] + rw [Finset.sum_eq_single 0 (by + intro k hk hk0 + have hkpos : 0 < k := Nat.pos_of_ne_zero hk0 + have hk_lt : k < p.natDegree + 1 := Finset.mem_range.mp hk + have hk_le : k ≤ p.natDegree := by omega + have hNpos : 0 < p.natDegree := lt_of_lt_of_le hkpos hk_le + have hne_sub : p.natDegree - k ≠ p.natDegree := + Nat.ne_of_lt (Nat.sub_lt hNpos hkpos) + simp [hne_sub]) (by simp)] + rw [Nat.sub_zero] + simp only [ite_true, Nat.choose_zero_right, Function.iterate_zero_apply, + one_nsmul, Polynomial.leadingCoeff] + +lemma rightMul_degree_le (d q : Polynomial B) : + (rightMul D d q).degree ≤ (d.natDegree + q.natDegree : WithBot ℕ) := by + rw [Polynomial.degree_le_iff_coeff_zero] + intro n hn + rw [rightMul, Polynomial.coeff_sum] + apply Finset.sum_eq_zero + intro j hj + apply Polynomial.coeff_eq_zero_of_degree_lt + have hj_le : j ≤ q.natDegree := Polynomial.le_natDegree_of_mem_supp j hj + have hdeg : (rightMulMonomial D d (q.coeff j) j).degree ≤ + (d.natDegree + j : WithBot ℕ) := + rightMulMonomial_degree_le D d (q.coeff j) j + have hbound : (d.natDegree + j : WithBot ℕ) ≤ + (d.natDegree + q.natDegree : WithBot ℕ) := by + exact_mod_cast Nat.add_le_add_left hj_le d.natDegree + exact lt_of_le_of_lt hdeg (lt_of_le_of_lt hbound hn) + +lemma rightMul_coeff_top [Nontrivial B] (d q : Polynomial B) + (hd : d.Monic) (hq : q ≠ 0) : + (rightMul D d q).coeff (d.natDegree + q.natDegree) = q.leadingCoeff := by + rw [rightMul, Polynomial.coeff_sum] + rw [Polynomial.sum_def] + have hqtop : q.natDegree ∈ q.support := + Polynomial.natDegree_mem_support_of_nonzero hq + rw [Finset.sum_eq_single q.natDegree (by + intro j hj hne + have hj_le : j ≤ q.natDegree := Polynomial.le_natDegree_of_mem_supp j hj + have hj_lt : j < q.natDegree := lt_of_le_of_ne hj_le hne + have hdeg : (rightMulMonomial D d (q.coeff j) j).degree ≤ + (d.natDegree + j : WithBot ℕ) := + rightMulMonomial_degree_le D d (q.coeff j) j + have hlt : (d.natDegree + j : WithBot ℕ) < + (d.natDegree + q.natDegree : WithBot ℕ) := by + exact_mod_cast Nat.add_lt_add_left hj_lt d.natDegree + have hzero : (rightMulMonomial D d (q.coeff j) j).coeff + (d.natDegree + q.natDegree) = 0 := + Polynomial.coeff_eq_zero_of_degree_lt (lt_of_le_of_lt hdeg hlt) + exact hzero) (by simp [hqtop])] + have hd0 : d ≠ 0 := hd.ne_zero + rw [rightMulMonomial_coeff_top D d hd0 (q.coeff q.natDegree) q.natDegree, + hd.leadingCoeff, one_mul] + rfl + +lemma rightMul_degree_eq [Nontrivial B] (d q : Polynomial B) + (hd : d.Monic) (hq : q ≠ 0) : + (rightMul D d q).degree = (d.natDegree + q.natDegree : WithBot ℕ) := by + have hle := rightMul_degree_le D d q + have htop : (rightMul D d q).coeff (d.natDegree + q.natDegree) = + q.leadingCoeff := rightMul_coeff_top D d q hd hq + have hq0 : q.leadingCoeff ≠ 0 := Polynomial.leadingCoeff_ne_zero.mpr hq + have hge : (d.natDegree + q.natDegree : WithBot ℕ) ≤ + (rightMul D d q).degree := by + by_contra hnot + have hlt0 : (rightMul D d q).degree < + (d.natDegree + q.natDegree : WithBot ℕ) := lt_of_not_ge hnot + have hlt : (rightMul D d q).degree < + ((d.natDegree + q.natDegree : ℕ) : WithBot ℕ) := by + have heq : (d.natDegree + q.natDegree : WithBot ℕ) = + ((d.natDegree + q.natDegree : ℕ) : WithBot ℕ) := + (WithBot.coe_add d.natDegree q.natDegree).symm + rwa [heq] at hlt0 + have hz := Polynomial.coeff_eq_zero_of_degree_lt hlt + exact hq0 (by rw [← htop, hz]) + exact le_antisymm hle hge + +theorem rightMul_injective [Nontrivial B] (d : Polynomial B) (hd : d.Monic) : + Function.Injective (rightMul D d) := by + intro q₁ q₂ hq + by_contra hne + have hdiff : q₁ - q₂ ≠ 0 := sub_ne_zero.mpr hne + have hz : rightMul D d (q₁ - q₂) = 0 := by + rw [rightMul_sub, hq, sub_self] + have hdeg := rightMul_degree_eq D d (q₁ - q₂) hd hdiff + rw [hz] at hdeg + have hne : (⊥ : WithBot ℕ) ≠ + (d.natDegree + (q₁ - q₂).natDegree : WithBot ℕ) := by + have heq : (d.natDegree + (q₁ - q₂).natDegree : WithBot ℕ) = + ((d.natDegree + (q₁ - q₂).natDegree : ℕ) : WithBot ℕ) := + (WithBot.coe_add d.natDegree (q₁ - q₂).natDegree).symm + rw [heq] + exact WithBot.bot_ne_coe + exact hne hdeg + +/-! The leading-degree theorem packages the strict filtered-intersection +property needed by the relative principal-source construction. This is an +Ore-polynomial filtration statement; it is deliberately not identified here +with the Bernstein filtration on the Weyl algebra. -/ + +theorem rightMul_degree_le_iff [Nontrivial B] (d q : Polynomial B) + (hd : d.Monic) (n : ℕ) : + (rightMul D d q).degree ≤ (n : WithBot ℕ) ↔ + q = 0 ∨ d.natDegree + q.natDegree ≤ n := by + constructor + · intro h + by_cases hq : q = 0 + · exact Or.inl hq + · right + have hdeg := rightMul_degree_eq D d q hd hq + rw [hdeg] at h + exact_mod_cast h + · intro h + rcases h with hzero | hq + · subst q + simp [rightMul_zero] + · by_cases hq0 : q = 0 + · subst q + simp [rightMul_zero] + · have hdeg := rightMul_degree_eq D d q hd hq0 + rw [hdeg] + exact_mod_cast hq + +lemma remainder_degree_lt (d r : Polynomial B) + (hr : r = 0 ∨ r.natDegree < d.natDegree) : + r.degree < (d.natDegree : WithBot ℕ) := by + rcases hr with rfl | hr + · exact WithBot.bot_lt_coe _ + · by_cases hr0 : r = 0 + · subst r + exact WithBot.bot_lt_coe _ + · rw [Polynomial.degree_eq_natDegree hr0] + exact_mod_cast hr + +theorem right_division_unique [Nontrivial B] (d p q₁ q₂ r₁ r₂ : Polynomial B) + (hd : d.Monic) + (h₁ : p = rightMul D d q₁ + r₁) + (h₂ : p = rightMul D d q₂ + r₂) + (hr₁ : r₁ = 0 ∨ r₁.natDegree < d.natDegree) + (hr₂ : r₂ = 0 ∨ r₂.natDegree < d.natDegree) : + q₁ = q₂ ∧ r₁ = r₂ := by + have heq : rightMul D d q₁ + r₁ = rightMul D d q₂ + r₂ := + h₁.symm.trans h₂ + have hrel : rightMul D d (q₁ - q₂) = r₂ - r₁ := by + rw [rightMul_sub] + apply (sub_eq_iff_eq_add).2 + calc + rightMul D d q₁ = + (rightMul D d q₂ + r₂) - r₁ := + (eq_sub_iff_add_eq).2 heq + _ = (r₂ - r₁) + rightMul D d q₂ := by abel + have hrdiff : (r₂ - r₁).degree < (d.natDegree : WithBot ℕ) := by + have h₁deg := remainder_degree_lt d r₁ hr₁ + have h₂deg := remainder_degree_lt d r₂ hr₂ + exact lt_of_le_of_lt (Polynomial.degree_sub_le r₂ r₁) (max_lt h₂deg h₁deg) + have hqeq : q₁ = q₂ := by + by_contra hne + have hdiff : q₁ - q₂ ≠ 0 := sub_ne_zero.mpr hne + have hleft := rightMul_degree_eq D d (q₁ - q₂) hd hdiff + have hleft_ge : (d.natDegree : WithBot ℕ) ≤ + (rightMul D d (q₁ - q₂)).degree := by + rw [hleft] + apply le_add_of_nonneg_right + exact_mod_cast (Nat.zero_le (q₁ - q₂).natDegree) + have hright_ge : (d.natDegree : WithBot ℕ) ≤ (r₂ - r₁).degree := by + rw [← hrel] + exact hleft_ge + exact (not_le_of_gt hrdiff) hright_ge + have hrEq : r₁ = r₂ := by + apply add_left_cancel (b := r₁) (a := rightMul D d q₂) + simpa [hqeq] using heq + exact ⟨hqeq, hrEq⟩ + +lemma cancel_degree_lt [Nontrivial B] (d p : Polynomial B) (hd : d.Monic) + (hp : p ≠ 0) (hdeg : d.natDegree ≤ p.natDegree) : + (p - rightMulMonomial D d p.leadingCoeff + (p.natDegree - d.natDegree)).degree < p.degree := by + let c : B := p.leadingCoeff + let j : ℕ := p.natDegree - d.natDegree + let q : Polynomial B := rightMulMonomial D d c j + have hd0 : d ≠ 0 := hd.ne_zero + have hc0 : c ≠ 0 := by + dsimp [c] + exact Polynomial.leadingCoeff_ne_zero.mpr hp + have hsum : d.natDegree + j = p.natDegree := by + dsimp [j] + exact Nat.add_sub_of_le hdeg + have hq_le : q.degree ≤ (p.natDegree : WithBot ℕ) := by + dsimp [q, c, j] + have h := rightMulMonomial_degree_le D d p.leadingCoeff + (p.natDegree - d.natDegree) + have hcast : (d.natDegree : WithBot ℕ) + + (p.natDegree - d.natDegree : WithBot ℕ) = + (p.natDegree : WithBot ℕ) := by + exact_mod_cast (Nat.add_sub_of_le hdeg) + rw [hcast] at h + exact h + have hq_top : q.coeff p.natDegree = c := by + dsimp [q] + rw [← hsum, + rightMulMonomial_coeff_top D d hd0 c j, hd.leadingCoeff, one_mul] + have hq0 : q ≠ 0 := by + intro hqzero + have hz := congrArg (fun z : Polynomial B => z.coeff p.natDegree) hqzero + change q.coeff p.natDegree = 0 at hz + rw [hq_top] at hz + exact hc0 hz + have hq_ge : (p.natDegree : WithBot ℕ) ≤ q.degree := by + by_contra hnot + have hlt : q.degree < (p.natDegree : WithBot ℕ) := lt_of_not_ge hnot + have hz : q.coeff p.natDegree = 0 := + Polynomial.coeff_eq_zero_of_degree_lt hlt + exact hc0 (by rw [← hq_top, hz]) + have hq_degree : q.degree = (p.natDegree : WithBot ℕ) := + le_antisymm hq_le hq_ge + have hp_degree : p.degree = (p.natDegree : WithBot ℕ) := + Polynomial.degree_eq_natDegree hp + have hleading : p.leadingCoeff = q.leadingCoeff := by + change p.coeff p.natDegree = q.coeff q.natDegree + have hq_nat : q.natDegree = p.natDegree := by + have hq_degree_nat : (q.natDegree : WithBot ℕ) = + (p.natDegree : WithBot ℕ) := by + rw [← Polynomial.degree_eq_natDegree hq0] + exact hq_degree + exact_mod_cast hq_degree_nat + rw [hq_nat, hq_top] + rfl + exact Polynomial.degree_sub_lt_left (hp_degree.trans hq_degree.symm) hp hleading + +theorem right_division_exists [Nontrivial B] (d p : Polynomial B) (hd : d.Monic) : + ∃ q r : Polynomial B, + p = rightMul D d q + r ∧ (r = 0 ∨ r.natDegree < d.natDegree) := by + let P : ℕ → Prop := fun n => + ∀ p : Polynomial B, p.natDegree = n → + ∃ q r : Polynomial B, + p = rightMul D d q + r ∧ (r = 0 ∨ r.natDegree < d.natDegree) + have hall : P p.natDegree := by + refine Nat.strong_induction_on p.natDegree ?_ + intro n ih + dsimp [P] + intro p hpN + by_cases hp0 : p = 0 + · subst p + exact ⟨0, 0, by simp [rightMul], Or.inl rfl⟩ + by_cases hsmall : p.natDegree < d.natDegree + · exact ⟨0, p, by simp [rightMul], Or.inr hsmall⟩ + · have hlarge : d.natDegree ≤ p.natDegree := Nat.le_of_not_gt hsmall + let c : B := p.leadingCoeff + let j : ℕ := p.natDegree - d.natDegree + let rm : Polynomial B := rightMulMonomial D d c j + have hcancel : (p - rm).degree < p.degree := by + dsimp [rm, c, j] + exact cancel_degree_lt D d p hd hp0 hlarge + by_cases hrem0 : p - rm = 0 + · refine ⟨Polynomial.monomial j c, 0, ?_, Or.inl rfl⟩ + rw [rightMul_monomial] + dsimp [rm] at hrem0 ⊢ + simpa [add_zero] using (sub_eq_zero.mp hrem0) + · have hremN : (p - rm).natDegree < p.natDegree := + Polynomial.natDegree_lt_natDegree hrem0 hcancel + have hremN' : (p - rm).natDegree < n := by + rw [← hpN] + exact hremN + obtain ⟨q, r, hqr, hrr⟩ := + ih (p - rm).natDegree hremN' (p - rm) rfl + refine ⟨Polynomial.monomial j c + q, r, ?_, hrr⟩ + calc + p = rm + (p - rm) := by abel + _ = rm + (rightMul D d q + r) := by rw [hqr] + _ = rightMul D d (Polynomial.monomial j c + q) + r := by + rw [rightMul_add, rightMul_monomial] + dsimp [rm] + abel + dsimp [P] at hall + exact hall p rfl + +/-- An ambient ring in which the Ore relation is represented. -/ +structure OreAmbient (B A : Type*) [Ring B] [Ring A] + (D : OreDivisionDerivation B) where + /-- The coefficient-ring embedding. -/ + embed : B →+* A + /-- The element representing the Ore variable. -/ + x : A + /-- The defining relation in the ambient ring. -/ + relation : ∀ b, x * embed b = embed b * x + embed (D b) + +namespace OreAmbient + +variable {B A : Type*} [Ring B] [Ring A] + (D : OreDivisionDerivation B) (O : OreAmbient B A D) + +/-- The inner derivation `a ↦ p*a-a*p`, used to formalize the iterated +commutator expansion of a power of `p`. -/ +def commutatorDerivation (p : A) : OreDivisionDerivation A where + toFun a := p * a - a * p + map_zero' := by simp + map_add' a b := by noncomm_ring + leibniz' a b := by noncomm_ring + +/-- The ambient Ore presentation for an inner derivation. -/ +def commutatorAmbient (p : A) : + OreAmbient A A (commutatorDerivation p) where + embed := RingHom.id A + x := p + relation := by + intro a + change p * a = a * p + (p * a - a * p) + noncomm_ring + +/-- A term in the iterated commutator expansion. -/ +def term (b : B) (i j : ℕ) : A := + O.embed ((D^[i]) b) * O.x ^ j + +lemma push_term (b : B) (i j : ℕ) : + O.x * term D O b i j = term D O b i (j + 1) + term D O b (i + 1) j := by + dsimp [term] + calc + O.x * (O.embed ((D^[i]) b) * O.x ^ j) = + (O.x * O.embed ((D^[i]) b)) * O.x ^ j := by rw [mul_assoc] + _ = (O.embed ((D^[i]) b) * O.x + + O.embed (D ((D^[i]) b))) * O.x ^ j := by rw [O.relation] + _ = O.embed ((D^[i]) b) * O.x ^ (j + 1) + + O.embed ((D^[i + 1]) b) * O.x ^ j := by + rw [add_mul, mul_assoc, ← pow_succ', Function.iterate_succ_apply'] + +lemma mul_nsmul_left (a u : A) (n : ℕ) : + a * (n • u) = n • (a * u) := by + induction n with + | zero => simp + | succ n ih => simp only [succ_nsmul, mul_add, ih] + +lemma nsmul_mul_right (a u : A) (n : ℕ) : + (n • a) * u = n • (a * u) := by + induction n with + | zero => simp + | succ n ih => simp only [succ_nsmul, add_mul, ih] + +/-- The normal-order expansion of `x^n * embed b`. -/ +def expansion (b : B) (n : ℕ) : A := + ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + n.choose ij.1 • term D O b ij.1 ij.2 + +theorem pow_mul (b : B) (n : ℕ) : + O.x ^ n * O.embed b = expansion D O b n := by + induction n with + | zero => + simp [expansion, term] + | succ n ih => + rw [pow_succ', mul_assoc, ih, expansion, Finset.mul_sum] + simp_rw [mul_nsmul_left O.x, O.push_term, smul_add] + rw [Finset.sum_add_distrib, expansion] + rw [Finset.sum_antidiagonal_choose_succ_nsmul] + have hsecond : + (∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + n.choose ij.1 • term D O b (ij.1 + 1) ij.2) = + ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + n.choose ij.2 • term D O b (ij.1 + 1) ij.2 := by + apply Finset.sum_congr rfl + intro ij hij + have hsum : ij.1 + ij.2 = n := + Finset.HasAntidiagonal.mem_antidiagonal.mp hij + have hi : ij.1 ≤ n := by omega + rw [← Nat.choose_symm hi] + rw [show n - ij.1 = ij.2 by omega] + rw [hsecond] + +/-- A single coefficient moved through a power of the Ore variable. -/ +def reverseTerm (b : B) (i j : ℕ) : A := + O.x ^ j * O.embed ((D^[i]) b) + +/-- A signed term for the reverse normal-order expansion. -/ +def reverseSignedTerm (b : B) (i j : ℕ) : A := + (-1 : A) ^ i * reverseTerm D O b i j + +/-- The reverse normal-order expansion of `x^n * embed b`. -/ +def reverseExpansion (b : B) (n : ℕ) : A := + ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + n.choose ij.1 • reverseSignedTerm D O b ij.1 ij.2 + +lemma reverseTerm_mul (b : B) (i j : ℕ) : + reverseTerm D O b i j * O.x = + reverseTerm D O b i (j + 1) - reverseTerm D O b (i + 1) j := by + dsimp [reverseTerm] + have hmove : O.embed ((D^[i]) b) * O.x = + O.x * O.embed ((D^[i]) b) - O.embed (D ((D^[i]) b)) := by + rw [O.relation] + noncomm_ring + rw [show O.x ^ j * O.embed ((D^[i]) b) * O.x = + O.x ^ j * (O.embed ((D^[i]) b) * O.x) by rw [mul_assoc], hmove, + mul_sub, pow_succ'] + rw [← mul_assoc, ← pow_succ, pow_succ'] + rw [← Function.iterate_succ_apply' D i b, + ← Function.iterate_succ_apply D i b] + +lemma reverseSignedTerm_mul (b : B) (i j : ℕ) : + reverseSignedTerm D O b i j * O.x = + reverseSignedTerm D O b i (j + 1) + + reverseSignedTerm D O b (i + 1) j := by + dsimp [reverseSignedTerm] + rw [mul_assoc, reverseTerm_mul, mul_sub, pow_succ'] + noncomm_ring + +theorem reverse_mul (b : B) (n : ℕ) : + O.embed b * O.x ^ n = reverseExpansion D O b n := by + induction n with + | zero => + simp [reverseExpansion, reverseSignedTerm, reverseTerm] + | succ n ih => + rw [pow_succ, ← mul_assoc, ih, reverseExpansion, Finset.sum_mul] + simp_rw [nsmul_mul_right, reverseSignedTerm_mul] + simp_rw [nsmul_add] + unfold reverseExpansion + have hsecond : + (∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + n.choose ij.1 • reverseSignedTerm D O b (ij.1 + 1) ij.2) = + ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + n.choose ij.2 • reverseSignedTerm D O b (ij.1 + 1) ij.2 := by + apply Finset.sum_congr rfl + intro ij hij + have hsum : ij.1 + ij.2 = n := + Finset.HasAntidiagonal.mem_antidiagonal.mp hij + have hi : ij.1 ≤ n := by omega + rw [← Nat.choose_symm hi] + rw [show n - ij.1 = ij.2 by omega] + rw [Finset.sum_add_distrib, hsecond] + exact (Finset.sum_antidiagonal_choose_succ_nsmul + (fun i j => reverseSignedTerm D O b i j) n).symm + +theorem commutator_pow_mul (p a : A) (m : ℕ) : + p ^ m * a = + OreAmbient.expansion (commutatorDerivation p) (commutatorAmbient p) a m := by + exact OreAmbient.pow_mul (commutatorDerivation p) (commutatorAmbient p) a m + +theorem commutator_pow_mul_explicit (p a : A) (m : ℕ) : + p ^ m * a = + ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal m, + m.choose ij.1 • (((commutatorDerivation p)^[ij.1]) a * p ^ ij.2) := by + simpa [OreAmbient.expansion, term, commutatorAmbient] using + (commutator_pow_mul (A := A) p a m) + +theorem commutator_pow_succ (p x : A) + (hpx : p * x - x * p = 1) (r : ℕ) : + p * x ^ (r + 1) - x ^ (r + 1) * p = (r + 1) • x ^ r := by + induction r with + | zero => simpa using hpx + | succ r ih => + calc + p * x ^ (r + 1 + 1) - x ^ (r + 1 + 1) * p = + (p * x ^ (r + 1) - x ^ (r + 1) * p) * x + + x ^ (r + 1) * (p * x - x * p) := by + noncomm_ring + _ = ((r + 1) • x ^ r) * x + x ^ (r + 1) * 1 := by rw [ih, hpx] + _ = (r + 2) • x ^ (r + 1) := by + rw [mul_one, nsmul_mul_right, pow_succ'] + have hpow : x ^ r * x = x * x ^ r := by + rw [← pow_succ, pow_succ'] + rw [hpow] + simp only [succ_nsmul] + +theorem commutator_iterate_pow_of_le (p x : A) + (hpx : p * x - x * p = 1) (j n : ℕ) (hjn : j ≤ n) : + (((commutatorDerivation p)^[j]) (x ^ n)) = + n.descFactorial j • x ^ (n - j) := by + induction j generalizing n with + | zero => simp + | succ j ih => + have hjn' : j ≤ n := by omega + rw [Function.iterate_succ_apply', ih n hjn'] + have hpow : x ^ (n - j) = x ^ ((n - j - 1) + 1) := by + congr 1 + omega + have hcomm : + (commutatorDerivation p) (x ^ (n - j)) = + (n - j) • x ^ (n - j - 1) := by + change p * x ^ (n - j) - x ^ (n - j) * p = _ + rw [hpow] + have hsub : n - j - 1 + 1 = n - j := by omega + simpa only [hsub] using commutator_pow_succ p x hpx (n - j - 1) + rw [OreDivisionDerivation.map_nsmul, hcomm, smul_smul, + Nat.descFactorial_succ] + rw [show n - (j + 1) = n - j - 1 by omega, Nat.mul_comm] + +theorem commutator_iterate_pow_of_lt (p x : A) + (hpx : p * x - x * p = 1) (j n : ℕ) (hnj : n < j) : + (((commutatorDerivation p)^[j]) (x ^ n)) = 0 := by + induction j with + | zero => omega + | succ j ih => + by_cases hj : n < j + · rw [Function.iterate_succ_apply', ih hj] + simp [commutatorDerivation] + · have hjeq : j = n := by omega + rw [Function.iterate_succ_apply', hjeq, + commutator_iterate_pow_of_le p x hpx n n le_rfl] + simp only [commutatorDerivation, tsub_self, pow_zero, nsmul_eq_mul, mul_one] + rw [Nat.cast_comm] + simp + +theorem commutator_iterate_pow (p x : A) + (hpx : p * x - x * p = 1) (j n : ℕ) : + (((commutatorDerivation p)^[j]) (x ^ n)) = + if j ≤ n then n.descFactorial j • x ^ (n - j) else 0 := by + by_cases hjn : j ≤ n + · simp [hjn, commutator_iterate_pow_of_le p x hpx j n hjn] + · have hnj : n < j := Nat.lt_of_not_ge hjn + simp [hjn, commutator_iterate_pow_of_lt p x hpx j n hnj] + +theorem commutator_pow_mul_pow (p x : A) + (hpx : p * x - x * p = 1) (k r : ℕ) : + p ^ k * x ^ r = + ∑ i ∈ Finset.range (k + 1), + if i ≤ r then + (k.choose i * r.descFactorial i) • + (x ^ (r - i) * p ^ (k - i)) + else 0 := by + rw [commutator_pow_mul_explicit] + rw [Finset.Nat.sum_antidiagonal_eq_sum_range_succ + (fun i j => k.choose i • + (((commutatorDerivation p)^[i]) (x ^ r) * p ^ j)) k] + apply Finset.sum_congr rfl + intro i hi + by_cases hir : i ≤ r + · rw [commutator_iterate_pow p x hpx i r] + simp only [ite_eq_left hir] + rw [show k - i = (k - i) by rfl] + simp [ + mul_assoc] + · rw [commutator_iterate_pow p x hpx i r] + simp [hir] + +/-! ### p-free monic corner + +The quotient by the image of right multiplication by `p` keeps only the +p-free term of the normal-ordering expansion. The following theorem isolates +the monic contribution; lower coefficient terms are handled by the separate +Newton arithmetic lemmas in `a2_newton_bound.lean`. +-/ + +/-- The linear map given by right multiplication by `p`. -/ +def pRightMulLinear {k A : Type*} [CommSemiring k] [Semiring A] [Algebra k A] + (p : A) : A →ₗ[k] A := + LinearMap.mulRight k p + +/-- The range of right multiplication by `p`. -/ +def pRightMulRange {k A : Type*} [CommSemiring k] [Semiring A] [Algebra k A] + (p : A) : Submodule k A := + LinearMap.range (pRightMulLinear p) + +lemma pRightMulRange_mem_of_mul_p {k A : Type*} [CommSemiring k] [Semiring A] + [Algebra k A] (p z : A) : z * p ∈ pRightMulRange (k := k) p := by + exact ⟨z, rfl⟩ + +theorem pfree_power_of_le {k A : Type*} [Field k] [Ring A] + [Algebra k A] (p x : A) (hpx : p * x - x * p = 1) + (u n : ℕ) (hun : u ≤ n) : + Submodule.mkQ (pRightMulRange (k := k) p) (p ^ u * x ^ n) = + (n.descFactorial u : k) • + Submodule.mkQ (pRightMulRange (k := k) p) (x ^ (n - u)) := by + rw [commutator_pow_mul_pow p x hpx u n] + rw [map_sum] + rw [Finset.sum_eq_single u] + · simp only [hun, ↓reduceIte, Nat.choose_self, one_mul, + nsmul_eq_mul, Nat.sub_self, pow_zero, mul_one] + change Submodule.Quotient.mk + (↑(n.descFactorial u) * x ^ (n - u)) = + (n.descFactorial u : k) • Submodule.Quotient.mk (x ^ (n - u)) + rw [← Submodule.Quotient.mk_smul] + congr 1 + simp [Algebra.smul_def] + · intro i hi hik + simp only [Finset.mem_range] at hi + have hlt : i < u := by omega + have hpow : p ^ (u - i) = p ^ (u - i - 1) * p := by + calc + p ^ (u - i) = p ^ ((u - i - 1) + 1) := by congr 1; omega + _ = p ^ (u - i - 1) * p := by rw [pow_succ] + have hmem : x ^ (n - i) * p ^ (u - i) ∈ + pRightMulRange (k := k) p := by + rw [hpow] + simpa [mul_assoc] using + (pRightMulRange_mem_of_mul_p (k := k) p + (x ^ (n - i) * p ^ (u - i - 1))) + have hzero : Submodule.mkQ (pRightMulRange (k := k) p) + (x ^ (n - i) * p ^ (u - i)) = 0 := + (Submodule.Quotient.mk_eq_zero (pRightMulRange (k := k) p)).2 hmem + simp only [ite_eq_left (by omega : i ≤ n), map_nsmul, hzero, smul_zero] + · simp + +theorem pfree_monic_corner {k A : Type*} [Field k] [Ring A] + [Algebra k A] (p x : A) (hpx : p * x - x * p = 1) + (m r : ℕ) : + Submodule.mkQ (pRightMulRange (k := k) p) (p ^ m * x ^ (m + r)) = + (Nat.choose m m * (m + r).descFactorial m : k) • + Submodule.mkQ (pRightMulRange (k := k) p) (x ^ r) := by + rw [commutator_pow_mul_pow p x hpx m (m + r)] + rw [map_sum] + rw [Finset.sum_eq_single m] + · simp only [Nat.choose_self, Nat.le_add_right, ↓reduceIte, Nat.sub_self, + Nat.cast_one, one_mul, nsmul_eq_mul] + simp only [Submodule.mkQ_apply, pow_zero, Nat.add_sub_cancel_left, mul_one] + rw [← Submodule.Quotient.mk_smul] + congr 1 + simp [Algebra.smul_def] + · intro i hi him + simp only [Finset.mem_range] at hi + have hpos : 0 < m - i := by omega + have hpow : p ^ (m - i) = p ^ (m - i - 1) * p := by + calc + p ^ (m - i) = p ^ ((m - i - 1) + 1) := by congr 1; omega + _ = p ^ (m - i - 1) * p := by rw [pow_succ] + have hmem : x ^ (m + r - i) * p ^ (m - i) ∈ + pRightMulRange (k := k) p := by + rw [hpow] + simpa [mul_assoc] using + (pRightMulRange_mem_of_mul_p (k := k) p + (x ^ (m + r - i) * p ^ (m - i - 1))) + have hzero : Submodule.mkQ (pRightMulRange (k := k) p) + (x ^ (m + r - i) * p ^ (m - i)) = 0 := + (Submodule.Quotient.mk_eq_zero (pRightMulRange (k := k) p)).2 hmem + simp only [ite_eq_left (by omega : i ≤ m + r), map_nsmul, hzero, smul_zero] + · simp + +lemma commutatorDerivation_mul_left (p b y : A) + (hpb : p * b = b * p) : + commutatorDerivation p (b * y) = b * commutatorDerivation p y := by + change p * (b * y) - (b * y) * p = b * (p * y - y * p) + rw [show p * (b * y) - (b * y) * p = (p * b) * y - b * (y * p) by + noncomm_ring, hpb] + noncomm_ring + +theorem commutator_iterate_mul_left (p b y : A) + (hpb : p * b = b * p) (j : ℕ) : + ((commutatorDerivation p)^[j]) (b * y) = + b * ((commutatorDerivation p)^[j]) y := by + induction j with + | zero => simp + | succ j ih => + rw [Function.iterate_succ_apply', ih, + commutatorDerivation_mul_left p b _ hpb] + congr 1 + rw [Function.iterate_succ_apply'] + +theorem commutator_iterate_add (p : A) (j : ℕ) (a b : A) : + ((commutatorDerivation p)^[j]) (a + b) = + ((commutatorDerivation p)^[j]) a + + ((commutatorDerivation p)^[j]) b := by + induction j with + | zero => simp + | succ j ih => + calc + ((commutatorDerivation p)^[j + 1]) (a + b) = + (commutatorDerivation p) + (((commutatorDerivation p)^[j]) (a + b)) := by + rw [Function.iterate_succ_apply'] + _ = (commutatorDerivation p) + (((commutatorDerivation p)^[j]) a + + ((commutatorDerivation p)^[j]) b) := by rw [ih] + _ = (commutatorDerivation p) (((commutatorDerivation p)^[j]) a) + + (commutatorDerivation p) (((commutatorDerivation p)^[j]) b) := by + change p * (((commutatorDerivation p)^[j]) a + + ((commutatorDerivation p)^[j]) b) - + ((((commutatorDerivation p)^[j]) a + + ((commutatorDerivation p)^[j]) b) * p) = _ + change p * (((commutatorDerivation p)^[j]) a + + ((commutatorDerivation p)^[j]) b) - + ((((commutatorDerivation p)^[j]) a + + ((commutatorDerivation p)^[j]) b) * p) = + (p * ((commutatorDerivation p)^[j]) a - + ((commutatorDerivation p)^[j]) a * p) + + (p * ((commutatorDerivation p)^[j]) b - + ((commutatorDerivation p)^[j]) b * p) + noncomm_ring + _ = ((commutatorDerivation p)^[j + 1]) a + + ((commutatorDerivation p)^[j + 1]) b := by + rw [Function.iterate_succ_apply', Function.iterate_succ_apply'] + +theorem commutator_iterate_sum (p : A) (j : ℕ) + (s : Finset ℕ) (f : ℕ → A) : + ((commutatorDerivation p)^[j]) (∑ i ∈ s, f i) = + ∑ i ∈ s, ((commutatorDerivation p)^[j]) (f i) := by + induction s using Finset.induction_on with + | empty => + have hz : ∀ n : ℕ, ((commutatorDerivation p)^[n]) 0 = 0 := by + intro n + induction n with + | zero => simp + | succ n ih => + rw [Function.iterate_succ_apply'] + change p * (((commutatorDerivation p)^[n]) 0) - + (((commutatorDerivation p)^[n]) 0) * p = 0 + rw [ih] + simp + rw [Finset.sum_empty, Finset.sum_empty] + exact hz j + | @insert a s ha ih => + rw [Finset.sum_insert ha, commutator_iterate_add, ih, + Finset.sum_insert ha] + +theorem commutator_iterate_eval_monomial_of_le + (p b : B) (n j : ℕ) (hpb : ∀ c : B, + O.embed p * O.embed c = O.embed c * O.embed p) + (hDp : D p = -1) (hjn : j ≤ n) : + (((commutatorDerivation (O.embed p))^[j]) + (O.embed b * O.x ^ n)) = + O.embed b * (n.descFactorial j • O.x ^ (n - j)) := by + have hpx : O.embed p * O.x - O.x * O.embed p = 1 := by + rw [O.relation p, hDp] + simp + calc + ((commutatorDerivation (O.embed p))^[j]) + (O.embed b * O.x ^ n) = + O.embed b * + ((commutatorDerivation (O.embed p))^[j]) (O.x ^ n) := by + exact commutator_iterate_mul_left (O.embed p) (O.embed b) + (O.x ^ n) (hpb b) j + _ = O.embed b * (n.descFactorial j • O.x ^ (n - j)) := by + rw [commutator_iterate_pow_of_le (O.embed p) O.x hpx j n hjn] + +theorem commutator_iterate_eval_monomial + (p b : B) (n j : ℕ) (hpb : ∀ c : B, + O.embed p * O.embed c = O.embed c * O.embed p) + (hDp : D p = -1) : + (((commutatorDerivation (O.embed p))^[j]) + (O.embed b * O.x ^ n)) = + if j ≤ n then + O.embed b * (n.descFactorial j • O.x ^ (n - j)) + else 0 := by + have hpx : O.embed p * O.x - O.x * O.embed p = 1 := by + rw [O.relation p, hDp] + simp + rw [commutator_iterate_mul_left (O.embed p) (O.embed b) + (O.x ^ n) (hpb b) j] + rw [commutator_iterate_pow (O.embed p) O.x hpx j n] + by_cases hjn : j ≤ n <;> simp [hjn] + +/-- Evaluation of a normal polynomial in an ambient Ore ring. -/ +def eval (p : Polynomial B) : A := + p.sum (fun i b => O.embed b * O.x ^ i) + +theorem commutator_iterate_eval (p : A) (q : Polynomial B) (j : ℕ) : + ((commutatorDerivation p)^[j]) (eval D O q) = + ∑ i ∈ q.support, + ((commutatorDerivation p)^[j]) + (O.embed (q.coeff i) * O.x ^ i) := by + unfold eval + rw [Polynomial.sum_def] + exact commutator_iterate_sum p j q.support + (fun i => O.embed (q.coeff i) * O.x ^ i) + +lemma eval_zero : eval D O 0 = 0 := by + simp [eval, Polynomial.sum_def] + +lemma eval_add (p q : Polynomial B) : + eval D O (p + q) = eval D O p + eval D O q := by + unfold eval + apply Polynomial.sum_add_index + · intro i + simp + · intro i a b + rw [map_add, add_mul] + +/-- The additive evaluation homomorphism. -/ +def evalAddHom : Polynomial B →+ A where + toFun := eval D O + map_zero' := eval_zero D O + map_add' := eval_add D O + +lemma eval_monomial (b : B) (j : ℕ) : + eval D O (Polynomial.monomial j b) = O.embed b * O.x ^ j := by + by_cases hb : b = 0 + · subst b + simp [eval, Polynomial.sum_def] + · unfold eval + rw [Polynomial.sum_def, Polynomial.support_monomial j hb] + simp [Polynomial.coeff_monomial] + +/-- The coefficient-left normal form of an iterated commutator. -/ +def commutatorNormal (q : Polynomial B) (j : ℕ) : Polynomial B := + ∑ i ∈ q.support, + if j ≤ i then + Polynomial.monomial (i - j) (i.descFactorial j • q.coeff i) + else 0 + +lemma commutatorNormal_degree_le (q : Polynomial B) (j : ℕ) : + (commutatorNormal q j).degree ≤ (q.natDegree - j : WithBot ℕ) := by + rw [Polynomial.degree_le_iff_coeff_zero] + intro n hn + have hn' : q.natDegree - j < n := by exact_mod_cast hn + unfold commutatorNormal + change (Polynomial.lcoeff B n) + (∑ i ∈ q.support, + if j ≤ i then + Polynomial.monomial (i - j) (i.descFactorial j • q.coeff i) + else 0) = 0 + rw [map_sum] + apply Finset.sum_eq_zero + intro i hi + have hi_le : i ≤ q.natDegree := Polynomial.le_natDegree_of_mem_supp i hi + by_cases hji : j ≤ i + · simp only [ite_eq_left hji] + change (Polynomial.monomial (i - j) + (i.descFactorial j • q.coeff i)).coeff n = 0 + rw [Polynomial.coeff_monomial] + simp [show i - j ≠ n by omega] + · simp [hji] + +lemma commutatorNormal_coeff_top [Nontrivial B] (q : Polynomial B) (j : ℕ) + (hq : q.Monic) (hjn : j ≤ q.natDegree) : + (commutatorNormal q j).coeff (q.natDegree - j) = + q.natDegree.descFactorial j • (1 : B) := by + unfold commutatorNormal + change (Polynomial.lcoeff B (q.natDegree - j)) + (∑ i ∈ q.support, + if j ≤ i then + Polynomial.monomial (i - j) (i.descFactorial j • q.coeff i) + else 0) = _ + rw [map_sum] + have hq0 : q ≠ 0 := hq.ne_zero + rw [Finset.sum_eq_single q.natDegree (by + intro i hi hne + have hi_le : i ≤ q.natDegree := + Polynomial.le_natDegree_of_mem_supp i hi + have hi_lt : i < q.natDegree := lt_of_le_of_ne hi_le hne + by_cases hji : j ≤ i + · have hneq : i - j ≠ q.natDegree - j := by omega + simp [hji, hneq, Polynomial.coeff_monomial] + · simp [hji]) (by + intro hnot + exact (hnot (Polynomial.natDegree_mem_support_of_nonzero hq0)).elim)] + simp [hjn, hq.leadingCoeff] + +theorem commutator_iterate_eval_eq_eval_normal + (p : B) (q : Polynomial B) (j : ℕ) + (hpb : ∀ c : B, + O.embed p * O.embed c = O.embed c * O.embed p) + (hDp : D p = -1) : + ((commutatorDerivation (O.embed p))^[j]) (eval D O q) = + eval D O (commutatorNormal q j) := by + rw [commutator_iterate_eval] + change (∑ i ∈ q.support, + ((commutatorDerivation (O.embed p))^[j]) + (O.embed (q.coeff i) * O.x ^ i)) = + (evalAddHom D O) (∑ i ∈ q.support, + if j ≤ i then + Polynomial.monomial (i - j) (i.descFactorial j • q.coeff i) + else 0) + rw [map_sum] + apply Finset.sum_congr rfl + intro i hi + by_cases hji : j ≤ i + · simp only [ite_eq_left hji] + rw [commutator_iterate_eval_monomial D O p (q.coeff i) i j hpb hDp] + rw [ite_eq_left hji] + change O.embed (q.coeff i) * + (i.descFactorial j • O.x ^ (i - j)) = + eval D O (Polynomial.monomial (i - j) + (i.descFactorial j • q.coeff i)) + rw [eval_monomial] + simp [] + simp [Nat.cast_comm, mul_assoc] + · rw [commutator_iterate_eval_monomial D O p (q.coeff i) i j hpb hDp] + simp [hji] + +lemma eval_push_eq_expansion (b : B) (n : ℕ) : + eval D O (OreDivision.push D b n) = expansion D O b n := by + change (evalAddHom D O) (OreDivision.push D b n) = expansion D O b n + unfold OreDivision.push + rw [map_sum] + change (∑ k ∈ Finset.range (n + 1), + eval D O (Polynomial.monomial (n - k) + (Nat.choose n k • (D^[k]) b))) = expansion D O b n + simp_rw [eval_monomial] + simp only [map_nsmul, smul_mul_assoc] + unfold expansion + rw [Finset.Nat.sum_antidiagonal_eq_sum_range_succ + (fun i j => n.choose i • term D O b i j) n] + apply Finset.sum_congr rfl + intro k hk + rfl + +theorem eval_push (b : B) (n : ℕ) : + eval D O (OreDivision.push D b n) = O.x ^ n * O.embed b := by + rw [eval_push_eq_expansion, (pow_mul D O b n).symm] + +lemma eval_rightTerm (i : ℕ) (a b : B) (j : ℕ) : + eval D O (rightTerm D i a b j) = + (O.embed a * O.x ^ i) * (O.embed b * O.x ^ j) := by + change (evalAddHom D O) (rightTerm D i a b j) = _ + unfold rightTerm + rw [map_sum] + change (∑ k ∈ Finset.range (i + 1), + eval D O (Polynomial.monomial (i - k + j) + (a * (Nat.choose i k • (D^[k]) b)))) = _ + simp_rw [eval_monomial] + simp only [map_nsmul, map_mul] + calc + ∑ k ∈ Finset.range (i + 1), + O.embed a * (Nat.choose i k • O.embed ((D^[k]) b)) * + O.x ^ (i - k + j) = + O.embed a * + (∑ k ∈ Finset.range (i + 1), + Nat.choose i k • + (O.embed ((D^[k]) b) * O.x ^ (i - k)) * O.x ^ j) := by + simp_rw [mul_assoc, smul_mul_assoc] + rw [← Finset.mul_sum] + apply congrArg (fun z => O.embed a * z) + apply Finset.sum_congr rfl + intro k hk + rw [pow_add] + simp only [mul_assoc] + _ = O.embed a * + ((O.x ^ i * O.embed b) * O.x ^ j) := by + rw [← Finset.sum_mul] + congr 1 + apply congrArg (fun z => z * O.x ^ j) + change (∑ k ∈ Finset.range (i + 1), + i.choose k • term D O b k (i - k)) = O.x ^ i * O.embed b + rw [← Finset.Nat.sum_antidiagonal_eq_sum_range_succ + (fun u v => i.choose u • term D O b u v) i] + change expansion D O b i = O.x ^ i * O.embed b + exact (pow_mul D O b i).symm + _ = (O.embed a * O.x ^ i) * (O.embed b * O.x ^ j) := by + noncomm_ring + +lemma eval_rightMulMonomial (p : Polynomial B) (b : B) (j : ℕ) : + eval D O (rightMulMonomial D p b j) = + eval D O p * (O.embed b * O.x ^ j) := by + change (evalAddHom D O) (rightMulMonomial D p b j) = _ + unfold rightMulMonomial + change (evalAddHom D O) (∑ i ∈ p.support, + rightTerm D i (p.coeff i) b j) = _ + rw [map_sum] + change (∑ i ∈ p.support, + eval D O (rightTerm D i (p.coeff i) b j)) = _ + simp_rw [eval_rightTerm] + unfold eval + rw [Polynomial.sum_def, Finset.sum_mul] + +lemma eval_rightMul (d q : Polynomial B) : + eval D O (rightMul D d q) = eval D O d * eval D O q := by + change (evalAddHom D O) (rightMul D d q) = _ + unfold rightMul + change (evalAddHom D O) (∑ j ∈ q.support, + rightMulMonomial D d (q.coeff j) j) = _ + rw [map_sum] + change (∑ j ∈ q.support, + eval D O (rightMulMonomial D d (q.coeff j) j)) = _ + simp_rw [eval_rightMulMonomial] + unfold eval + simp only [Polynomial.sum_def] + rw [Finset.mul_sum] + +theorem eval_right_division_sound [Nontrivial B] (d p : Polynomial B) + (hd : d.Monic) : + ∃ q r : Polynomial B, + eval D O p = eval D O d * eval D O q + eval D O r ∧ + (r = 0 ∨ r.natDegree < d.natDegree) := by + obtain ⟨q, r, hdecomp, hrem⟩ := right_division_exists D d p hd + refine ⟨q, r, ?_, hrem⟩ + rw [hdecomp, eval_add D O, eval_rightMul D O] + +end OreAmbient + +end OreDivision + +end +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightHilbertBasis.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightHilbertBasis.lean new file mode 100644 index 0000000000..277202ce05 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightHilbertBasis.lean @@ -0,0 +1,568 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightQuotient +public import Mathlib.RingTheory.Noetherian.Filter + + +/-! +# The derivation-Ore right Hilbert-basis theorem + +This file is a right-sided version of the leading-coefficient proof for a +differential Ore extension. Coefficients are allowed to be noncommutative: +right ideals of the coefficient ring are represented as submodules for the +opposite scalar ring. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.OreDerivationRightHilbertBasis + +open Polynomial +open AlgebraicAnalysis +open AlgebraicAnalysis.OreDivision +open AlgebraicAnalysis.OreAssociativity +open AlgebraicAnalysis.OreRightQuotient + +noncomputable section + +universe u + +variable {B : Type u} [Ring B] + +/-- The right Hilbert-basis assertion for one derivation-Ore stage. -/ +def DerivationOreRightHilbertBasis : Prop := + ∀ {B : Type u} [Ring B], IsNoetherianRing Bᵐᵒᵖ → + ∀ D : OreDivisionDerivation B, + IsNoetherianRing (NormalOre D)ᵐᵒᵖ + +@[simp] +theorem rightScalar_smul_def (b : Bᵐᵒᵖ) (c : B) : + b • c = c * b.unop := by + rw [MulOpposite.smul_eq_mul_unop] + +private theorem rightScalar_top_span : + Submodule.span Bᵐᵒᵖ ({1} : Set B) = ⊤ := by + apply top_unique + intro c hc + have h1 : (1 : B) ∈ Submodule.span Bᵐᵒᵖ ({1} : Set B) := + Submodule.subset_span (by simp) + have hc' := Submodule.smul_mem + (Submodule.span Bᵐᵒᵖ ({1} : Set B)) (MulOpposite.op c) h1 + simpa [rightScalar_smul_def] using hc' + +private theorem rightScalar_module_finite : Module.Finite Bᵐᵒᵖ B := by + refine ⟨?_⟩ + refine ⟨({1} : Finset B), ?_⟩ + simpa only [Finset.coe_singleton] using + (rightScalar_top_span (B := B)) + +private theorem rightScalar_isNoetherian + [IsNoetherianRing Bᵐᵒᵖ] : IsNoetherian Bᵐᵒᵖ B := by + let : Module.Finite Bᵐᵒᵖ B := rightScalar_module_finite + exact isNoetherian_of_isNoetherianRing_of_finite Bᵐᵒᵖ B + +/-- Additive equivalence between coefficient-left polynomials and normal forms. -/ +def normalPolyEquiv (D : OreDivisionDerivation B) : + Polynomial B ≃+ NormalOre D := + { normalFormAddEquiv D with } + +lemma rightMul_coeff_C_of_degree_le + (D : OreDivisionDerivation B) (p : Polynomial B) (b : B) (n : ℕ) + (hp : p.degree ≤ (n : WithBot ℕ)) : + (rightMul D p (Polynomial.C b)).coeff n = p.coeff n * b := by + by_cases hp0 : p = 0 + · subst p + simp [OreDivision.rightMul, OreDivision.rightMulMonomial, + OreDivision.rightTerm] + have hpnat : p.natDegree ≤ n := + Polynomial.natDegree_le_of_degree_le hp + by_cases heq : p.natDegree = n + · rw [show Polynomial.C b = Polynomial.monomial 0 b by simp, + rightMul_monomial] + have htop := rightMulMonomial_coeff_top D p hp0 b 0 + rw [Nat.add_zero] at htop + simpa [Polynomial.leadingCoeff, heq] using htop + · have hlt : p.natDegree < n := lt_of_le_of_ne hpnat heq + have hprod : (rightMul D p (Polynomial.C b)).degree < + (n : WithBot ℕ) := by + have hle := rightMul_degree_le D p (Polynomial.C b) + have hnatC : (Polynomial.C b).natDegree = 0 := by simp + rw [hnatC] at hle + have hle' : (rightMul D p (Polynomial.C b)).degree ≤ + (p.natDegree : WithBot ℕ) := by simpa using hle + exact lt_of_le_of_lt hle' (WithBot.coe_lt_coe.2 hlt) + have hzprod := Polynomial.coeff_eq_zero_of_degree_lt hprod + have hz : p.coeff n = 0 := by + apply Polynomial.coeff_eq_zero_of_degree_lt + rw [Polynomial.degree_eq_natDegree hp0] + exact WithBot.coe_lt_coe.2 hlt + simp [hzprod, hz] + +/-- The degree-at-most-`n` submodule of normal forms. -/ +def normalDegreeLE (D : OreDivisionDerivation B) (n : ℕ) : + Submodule Bᵐᵒᵖ (NormalOre D) := + { carrier := {z | ((normalPolyEquiv D).symm z).degree ≤ (n : WithBot ℕ)} + zero_mem' := by + change ((normalPolyEquiv D).symm (0 : NormalOre D)).degree ≤ _ + rw [(normalPolyEquiv D).symm.map_zero] + simp + add_mem' := by + intro x y hx hy + change ((normalPolyEquiv D).symm (x + y)).degree ≤ _ + rw [(normalPolyEquiv D).symm.map_add] + exact le_trans (Polynomial.degree_add_le _ _) (max_le hx hy) + smul_mem' := by + intro b z hz + obtain ⟨p, rfl⟩ := normalForm_surjective D z + change ((normalPolyEquiv D).symm (b • normalForm D p)).degree ≤ _ + change ((normalPolyEquiv D).symm ((normalPolyEquiv D) p)).degree ≤ _ at hz + rw [(normalPolyEquiv D).symm_apply_apply] at hz + have hpdeg : p.degree ≤ (n : WithBot ℕ) := hz + have hpnat : p.natDegree ≤ n := + Polynomial.natDegree_le_of_degree_le hpdeg + have hmul : b • normalForm D p = + normalForm D (rightMul D p (Polynomial.C b.unop)) := by + rw [normalOre_op_smul_def, ← normalForm_C, ← normalForm_mul] + rw [hmul] + change ((normalPolyEquiv D).symm + ((normalPolyEquiv D) (rightMul D p (Polynomial.C b.unop)))).degree ≤ _ + rw [(normalPolyEquiv D).symm_apply_apply] + exact (rightMul_degree_le D p (Polynomial.C b.unop)).trans + (by + simp only [Polynomial.natDegree_C, Nat.cast_zero, add_zero] + exact_mod_cast hpnat) } + +/-- The `n`th coefficient functional on the degree window. -/ +def normalCoeffNth (D : OreDivisionDerivation B) (n : ℕ) : + normalDegreeLE D n →ₗ[Bᵐᵒᵖ] B where + toFun z := ((normalPolyEquiv D).symm z).coeff n + map_add' x y := by + change ((normalPolyEquiv D).symm (x + y)).coeff n = _ + rw [(normalPolyEquiv D).symm.map_add, Polynomial.coeff_add] + map_smul' b z := by + let p := (normalPolyEquiv D).symm z.1 + have hp : p.degree ≤ (n : WithBot ℕ) := by + change ((normalPolyEquiv D).symm z.1).degree ≤ _ + exact z.2 + have hz : normalForm D p = z.1 := by + change (normalPolyEquiv D) p = z.1 + exact (normalPolyEquiv D).apply_symm_apply z.1 + change ((normalPolyEquiv D).symm (b • z.1)).coeff n = + b • ((normalPolyEquiv D).symm z.1).coeff n + rw [← hz] + rw [normalOre_op_smul_def, ← normalForm_C, ← normalForm_mul] + change ((normalPolyEquiv D).symm + ((normalPolyEquiv D) (rightMul D p (Polynomial.C b.unop)))).coeff n = + b • ((normalPolyEquiv D).symm ((normalPolyEquiv D) p)).coeff n + rw [(normalPolyEquiv D).symm_apply_apply, + (normalPolyEquiv D).symm_apply_apply] + rw [rightMul_coeff_C_of_degree_le D p b.unop n hp] + rfl + +/-- The degree window cut out by a right ideal. -/ +def rightIdealDegreeLE (D : OreDivisionDerivation B) + (I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D)) (n : ℕ) : + Submodule Bᵐᵒᵖ (NormalOre D) := + normalDegreeLE D n ⊓ rightIdealAsCoeffSubmodule D I + +/-- The leading-coefficient submodule at a fixed degree. -/ +def leadingCoeffNth (D : OreDivisionDerivation B) + (I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D)) (n : ℕ) : + Submodule Bᵐᵒᵖ B := + let J := rightIdealDegreeLE D I n + let incl : J →ₗ[Bᵐᵒᵖ] normalDegreeLE D n := + { toFun := fun z => ⟨z.1, z.2.1⟩ + map_add' := by intro x y; rfl + map_smul' := by intro b x; rfl } + let f : J →ₗ[Bᵐᵒᵖ] B := (normalCoeffNth D n).comp incl + Submodule.map f (⊤ : Submodule Bᵐᵒᵖ J) + +lemma mem_leadingCoeffNth (D : OreDivisionDerivation B) + (I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D)) (n : ℕ) (c : B) : + c ∈ leadingCoeffNth D I n ↔ + ∃ p : Polynomial B, normalForm D p ∈ I ∧ + p.degree ≤ (n : WithBot ℕ) ∧ p.coeff n = c := by + constructor + · intro hc + change c ∈ Submodule.map _ (⊤ : Submodule Bᵐᵒᵖ (rightIdealDegreeLE D I n)) at hc + rw [Submodule.mem_map] at hc + rcases hc with ⟨z, hz, rfl⟩ + let p := (normalPolyEquiv D).symm z.1 + refine ⟨p, ?_, ?_, ?_⟩ + · have hpz : normalForm D p = z.1 := by + change (normalPolyEquiv D) p = z.1 + exact (normalPolyEquiv D).apply_symm_apply z.1 + rw [hpz] + simpa [rightIdealAsCoeffSubmodule] using z.2.2 + · exact z.2.1 + · change ((normalPolyEquiv D).symm z.1).coeff n = _ + rfl + · rintro ⟨p, hpI, hpdeg, hpc⟩ + let z : rightIdealDegreeLE D I n := + ⟨normalForm D p, (by + change ((normalPolyEquiv D).symm ((normalPolyEquiv D) p)).degree ≤ _ + rw [(normalPolyEquiv D).symm_apply_apply] + exact hpdeg), hpI⟩ + refine ⟨z, Submodule.mem_top, ?_⟩ + dsimp [z, normalCoeffNth] + have hinv : (normalPolyEquiv D).symm (normalForm D p) = p := by + change (normalPolyEquiv D).symm ((normalPolyEquiv D) p) = p + exact (normalPolyEquiv D).symm_apply_apply p + rw [hinv] + exact hpc + +lemma rightMul_Xpow_coeff_of_degree_le + [Nontrivial B] + (D : OreDivisionDerivation B) (p : Polynomial B) (n j : ℕ) + (hp : p.degree ≤ (n : WithBot ℕ)) : + (rightMul D p (Polynomial.X ^ j)).coeff (n + j) = p.coeff n := by + by_cases hp0 : p = 0 + · subst p + simp [OreDivision.rightMul, OreDivision.rightMulMonomial, + OreDivision.rightTerm, Polynomial.sum_def] + have hpnat : p.natDegree ≤ n := + Polynomial.natDegree_le_of_degree_le hp + by_cases heq : p.natDegree = n + · rw [Polynomial.X_pow_eq_monomial, rightMul_monomial] + have htop := rightMulMonomial_coeff_top D p hp0 1 j + simpa [Polynomial.leadingCoeff, heq] using htop + · have hlt : p.natDegree < n := lt_of_le_of_ne hpnat heq + have hprod : (rightMul D p (Polynomial.X ^ j)).degree < + ((n + j : ℕ) : WithBot ℕ) := by + have hle := rightMul_degree_le D p (Polynomial.X ^ j) + have hnatX : (Polynomial.X ^ j : Polynomial B).natDegree = j := by + simp + rw [hnatX] at hle + have hlt' : p.natDegree + j < n + j := Nat.add_lt_add_right hlt j + exact lt_of_le_of_lt hle (WithBot.coe_lt_coe.2 hlt') + have hzprod := Polynomial.coeff_eq_zero_of_degree_lt hprod + have hz : p.coeff n = 0 := by + apply Polynomial.coeff_eq_zero_of_degree_lt + rw [Polynomial.degree_eq_natDegree hp0] + exact WithBot.coe_lt_coe.2 hlt + simp [hzprod, hz] + +lemma leadingCoeffNth_mono [Nontrivial B] (D : OreDivisionDerivation B) + (I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D)) + {m n : ℕ} (hmn : m ≤ n) : + leadingCoeffNth D I m ≤ leadingCoeffNth D I n := by + intro c hc + rw [mem_leadingCoeffNth] at hc ⊢ + rcases hc with ⟨p, hpI, hpdeg, hpc⟩ + refine ⟨rightMul D p (Polynomial.X ^ (n - m)), ?_, ?_, ?_⟩ + · rw [normalForm_mul] + have hmem := I.smul_mem + (MulOpposite.op (normalForm D (Polynomial.X ^ (n - m)))) hpI + simpa [op_smul_eq_mul] using hmem + · have hpnat : p.natDegree ≤ m := + Polynomial.natDegree_le_of_degree_le hpdeg + have hdeg := rightMul_degree_le D p (Polynomial.X ^ (n - m)) + have hnat : (Polynomial.X ^ (n - m) : Polynomial B).natDegree = n - m := + Polynomial.natDegree_X_pow _ + rw [hnat] at hdeg + have hadd : p.natDegree + (n - m) ≤ n := by + exact (Nat.add_le_add_right hpnat (n - m)).trans_eq + (Nat.add_sub_of_le hmn) + exact hdeg.trans (by exact_mod_cast hadd) + · have hc' := rightMul_Xpow_coeff_of_degree_le D p m (n - m) hpdeg + rw [Nat.add_sub_of_le hmn] at hc' + exact hc'.trans hpc + +/-- The monotone chain of leading-coefficient submodules. -/ +def leadingCoeffChain [Nontrivial B] (D : OreDivisionDerivation B) + (I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D)) : + ℕ →o Submodule Bᵐᵒᵖ B where + toFun n := leadingCoeffNth D I n + monotone' _m _n h := leadingCoeffNth_mono D I h + +theorem exists_leadingCoeff_stable + [Nontrivial B] + [IsNoetherianRing Bᵐᵒᵖ] + (D : OreDivisionDerivation B) + (I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D)) : + ∃ N : ℕ, ∀ n, N ≤ n → leadingCoeffNth D I n = leadingCoeffNth D I N := by + let : IsNoetherian Bᵐᵒᵖ B := rightScalar_isNoetherian + let f := leadingCoeffChain D I + have hconst : Filter.EventuallyConst + (f : ℕ → Submodule Bᵐᵒᵖ B) Filter.atTop := + eventuallyConst_of_isNoetherian f + rcases Filter.eventuallyConst_atTop.mp hconst with ⟨N, hN⟩ + exact ⟨N, fun n hn => hN n hn⟩ + +lemma normalDegreeLE_le_window (D : OreDivisionDerivation B) (n : ℕ) : + normalDegreeLE D n ≤ rightCoefficientWindow D (n + 1) := by + intro z hz + let p := (normalPolyEquiv D).symm z + have hpdeg : p.degree ≤ (n : WithBot ℕ) := by + change ((normalPolyEquiv D).symm z).degree ≤ _ + exact hz + have hp : p = 0 ∨ p.natDegree < n + 1 := by + by_cases hp0 : p = 0 + · exact Or.inl hp0 + · right + have hpnat : p.natDegree ≤ n := + Polynomial.natDegree_le_of_degree_le hpdeg + omega + have hw := normalForm_mem_rightCoefficientWindow_of_degree_lt + D p (n + 1) hp + have hzval : normalForm D p = z := by + change (normalPolyEquiv D) p = z + exact (normalPolyEquiv D).apply_symm_apply z + rw [← hzval] + exact hw + +/-- The degree window embedded in the finite coefficient window. -/ +def normalDegreeLEToWindow (D : OreDivisionDerivation B) (n : ℕ) : + normalDegreeLE D n →ₗ[Bᵐᵒᵖ] rightCoefficientWindow D (n + 1) where + toFun z := ⟨z.1, normalDegreeLE_le_window D n z.2⟩ + map_add' x y := by rfl + map_smul' b x := by rfl + +/-- Inclusion of an ideal degree window into the full degree window. -/ +def normalDegreeIncl (D : OreDivisionDerivation B) (n : ℕ) + (J : Submodule Bᵐᵒᵖ (NormalOre D)) + (hJ : J ≤ normalDegreeLE D n) : + J →ₗ[Bᵐᵒᵖ] normalDegreeLE D n where + toFun z := ⟨z.1, hJ z.2⟩ + map_add' x y := by rfl + map_smul' b x := by rfl + +theorem rightIdealDegreeLE_fg + [IsNoetherianRing Bᵐᵒᵖ] + (D : OreDivisionDerivation B) + (I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D)) (n : ℕ) : + (rightIdealDegreeLE D I n).FG := by + let : Module.Finite Bᵐᵒᵖ (rightCoefficientWindow D (n + 1)) := + Module.Finite.span_of_finite Bᵐᵒᵖ (Set.finite_range + (fun j : Fin (n + 1) => normalForm D (Polynomial.X ^ (j : ℕ)))) + let : IsNoetherian Bᵐᵒᵖ (rightCoefficientWindow D (n + 1)) := + isNoetherian_of_isNoetherianRing_of_finite Bᵐᵒᵖ + (rightCoefficientWindow D (n + 1)) + let : Module.Finite Bᵐᵒᵖ (normalDegreeLE D n) := + Module.Finite.of_injective + (normalDegreeLEToWindow D n) (by + intro x y h + apply Subtype.ext + exact congrArg + (fun z : rightCoefficientWindow D (n + 1) => (z : NormalOre D)) h) + let : IsNoetherian Bᵐᵒᵖ (normalDegreeLE D n) := + isNoetherian_of_isNoetherianRing_of_finite Bᵐᵒᵖ + (normalDegreeLE D n) + let incl := normalDegreeIncl D n (rightIdealDegreeLE D I n) inf_le_left + let : Module.Finite Bᵐᵒᵖ (rightIdealDegreeLE D I n) := + Module.Finite.of_injective incl (by + intro x y h + apply Subtype.ext + exact congrArg + (fun z : normalDegreeLE D n => (z : NormalOre D)) h) + have htop : (⊤ : Submodule Bᵐᵒᵖ (rightIdealDegreeLE D I n)).FG := + Module.finite_def.mp (inferInstance : + Module.Finite Bᵐᵒᵖ (rightIdealDegreeLE D I n)) + exact (Submodule.fg_top (rightIdealDegreeLE D I n)).mp htop + +theorem normalOre_rightIdeal_fg_of_op_noetherian + [Nontrivial B] [IsNoetherianRing Bᵐᵒᵖ] + (D : OreDivisionDerivation B) + (I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D)) : I.FG := by + obtain ⟨N, hstable⟩ := exists_leadingCoeff_stable D I + obtain ⟨s, hs⟩ := rightIdealDegreeLE_fg D I N + let K : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D) := + Submodule.span (NormalOre D)ᵐᵒᵖ (s : Set (NormalOre D)) + have hKsub : K ≤ I := by + apply Submodule.span_le.2 + intro z hz + have hzJ : z ∈ rightIdealDegreeLE D I N := by + rw [← hs] + exact Submodule.subset_span hz + exact hzJ.2 + refine ⟨s, ?_⟩ + apply le_antisymm hKsub + intro z hz + obtain ⟨p, rfl⟩ := normalForm_surjective D z + have hBspan_le : + Submodule.span Bᵐᵒᵖ (s : Set (NormalOre D)) ≤ + rightIdealAsCoeffSubmodule D K := by + apply Submodule.span_le.2 + intro x hx + exact Submodule.subset_span hx + have hgen : ∀ n : ℕ, ∀ p : Polynomial B, + p.natDegree = n → normalForm D p ∈ I → normalForm D p ∈ K := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro p hpn hpI + by_cases hp0 : p = 0 + · subst p + simp [normalForm_zero] + by_cases hsmall : p.natDegree ≤ N + · have hpdeg : p.degree ≤ (N : WithBot ℕ) := by + rw [Polynomial.degree_eq_natDegree hp0] + exact WithBot.coe_le_coe.2 hsmall + have hnormalP : normalForm D p ∈ normalDegreeLE D N := by + have hinv : (normalPolyEquiv D).symm (normalForm D p) = p := by + change (normalPolyEquiv D).symm ((normalPolyEquiv D) p) = p + exact (normalPolyEquiv D).symm_apply_apply p + change ((normalPolyEquiv D).symm (normalForm D p)).degree ≤ + (N : WithBot ℕ) + rw [hinv] + exact hpdeg + have hpJ : normalForm D p ∈ rightIdealDegreeLE D I N := + ⟨hnormalP, hpI⟩ + have hpB : normalForm D p ∈ + Submodule.span Bᵐᵒᵖ (s : Set (NormalOre D)) := by + rw [hs] + exact hpJ + exact hBspan_le hpB + · have hlarge : N < p.natDegree := lt_of_not_ge hsmall + let c := p.leadingCoeff + have hcne : c ≠ 0 := Polynomial.leadingCoeff_ne_zero.mpr hp0 + have hpc : p.coeff n = c := by + dsimp [c] + rw [Polynomial.leadingCoeff, hpn] + have hcN : c ∈ leadingCoeffNth D I N := by + rw [← hstable p.natDegree (le_of_lt hlarge)] + rw [mem_leadingCoeffNth] + refine ⟨p, hpI, ?_, ?_⟩ + · exact Polynomial.degree_le_natDegree + · dsimp [c] + rcases (mem_leadingCoeffNth D I N c).mp hcN with + ⟨q, hqI, hqdeg, hqcoeff⟩ + let u := rightMul D q (Polynomial.X ^ (n - N)) + have huI : normalForm D u ∈ I := by + rw [normalForm_mul] + have hmem := I.smul_mem + (MulOpposite.op (normalForm D (Polynomial.X ^ (n - N)))) hqI + simpa [u, op_smul_eq_mul] using hmem + have huK : normalForm D u ∈ K := by + have hnormalQ : normalForm D q ∈ normalDegreeLE D N := by + have hinv : (normalPolyEquiv D).symm (normalForm D q) = q := by + change (normalPolyEquiv D).symm ((normalPolyEquiv D) q) = q + exact (normalPolyEquiv D).symm_apply_apply q + change ((normalPolyEquiv D).symm (normalForm D q)).degree ≤ + (N : WithBot ℕ) + rw [hinv] + exact hqdeg + have hqJ : normalForm D q ∈ rightIdealDegreeLE D I N := + ⟨hnormalQ, hqI⟩ + have hqB : normalForm D q ∈ + Submodule.span Bᵐᵒᵖ (s : Set (NormalOre D)) := by + rw [hs] + exact hqJ + have hmulK := K.smul_mem + (MulOpposite.op (normalForm D (Polynomial.X ^ (n - N)))) + (hBspan_le hqB) + simpa [u, normalForm_mul, op_smul_eq_mul] using hmulK + have hucoeff : u.coeff n = c := by + dsimp [u] + have hqcoeff' := + rightMul_Xpow_coeff_of_degree_le D q N (n - N) hqdeg + have hNn : N ≤ n := hpn ▸ le_of_lt hlarge + rw [Nat.add_sub_of_le hNn] at hqcoeff' + rw [hqcoeff'] + exact hqcoeff + have hu0 : u ≠ 0 := by + intro hu + have hthis : u.coeff n = (0 : Polynomial B).coeff n := by + simpa using congrArg (fun r : Polynomial B => r.coeff n) hu + rw [hucoeff] at hthis + exact hcne (by simpa using hthis) + have hule : u.degree ≤ (n : WithBot ℕ) := by + dsimp [u] + have hdeg := rightMul_degree_le D q (Polynomial.X ^ (n - N)) + have hqnat : q.natDegree ≤ N := + Polynomial.natDegree_le_of_degree_le hqdeg + have hnatX : (Polynomial.X ^ (n - N) : Polynomial B).natDegree = + n - N := Polynomial.natDegree_X_pow _ + rw [hnatX] at hdeg + have hadd : q.natDegree + (n - N) ≤ n := by + exact (Nat.add_le_add_right hqnat (n - N)).trans_eq + (Nat.add_sub_of_le (hpn ▸ le_of_lt hlarge)) + exact hdeg.trans (by exact_mod_cast hadd) + have hun : u.natDegree = n := by + apply le_antisymm + · exact Polynomial.natDegree_le_of_degree_le hule + · apply Polynomial.le_natDegree_of_mem_supp + rw [Polynomial.mem_support_iff] + exact hucoeff.trans_ne hcne + have hudeg : u.degree = (n : WithBot ℕ) := by + rw [Polynomial.degree_eq_natDegree hu0, hun] + have hpdeg : p.degree = (n : WithBot ℕ) := by + rw [Polynomial.degree_eq_natDegree hp0, hpn] + have hplead : p.leadingCoeff = u.leadingCoeff := by + rw [Polynomial.leadingCoeff, hpn, + Polynomial.leadingCoeff, hun, hpc, hucoeff] + let r := p - u + have hrI : normalForm D r ∈ I := by + dsimp [r] + rw [show normalForm D (p - u) = + normalForm D p - normalForm D u from + map_sub (normalFormAddHom D) p u] + exact I.sub_mem hpI huI + have hrdeg : r.degree < (n : WithBot ℕ) := by + dsimp [r] + have hsub := Polynomial.degree_sub_lt_left (hpdeg.trans hudeg.symm) hp0 hplead + simpa [hpdeg] using hsub + by_cases hr0 : r = 0 + · have hpr : p = u := sub_eq_zero.mp hr0 + rw [hpr] + exact huK + · have hrnat : r.natDegree < n := by + have hrdeg' : (r.natDegree : WithBot ℕ) < + (n : WithBot ℕ) := by + rw [Polynomial.degree_eq_natDegree hr0] at hrdeg + exact hrdeg + exact WithBot.coe_lt_coe.mp hrdeg' + have hrK := ih r.natDegree hrnat r rfl hrI + have huK' := huK + change normalForm D p ∈ K + rw [show p = u + r by dsimp [r]; abel, normalForm_add] + exact K.add_mem huK' hrK + exact hgen p.natDegree p rfl hz + +theorem normalOre_op_isNoetherian_of_nontrivial + [Nontrivial B] [IsNoetherianRing Bᵐᵒᵖ] + (D : OreDivisionDerivation B) : + IsNoetherianRing (NormalOre D)ᵐᵒᵖ := by + refine ⟨?_⟩ + intro J + let e : NormalOre D ≃ₗ[(NormalOre D)ᵐᵒᵖ] (NormalOre D)ᵐᵒᵖ := + MulOpposite.opLinearEquiv (NormalOre D)ᵐᵒᵖ + let I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D) := + J.comap e.toLinearMap + have hI : I.FG := normalOre_rightIdeal_fg_of_op_noetherian D I + have hmap : I.map e.toLinearMap = J := by + exact Submodule.map_comap_eq_of_surjective e.surjective J + rw [← hmap] + exact hI.map e.toLinearMap + +theorem normalOre_op_isNoetherian_of_subsingleton + [Subsingleton B] (D : OreDivisionDerivation B) : + IsNoetherianRing (NormalOre D)ᵐᵒᵖ := by + let : Subsingleton (NormalOre D) := + ⟨fun x y => by + obtain ⟨p, rfl⟩ := normalForm_surjective D x + obtain ⟨q, rfl⟩ := normalForm_surjective D y + exact congrArg (normalForm D) (Subsingleton.elim p q)⟩ + rw [isNoetherianRing_iff] + exact isNoetherian_of_subsingleton + (NormalOre D)ᵐᵒᵖ (NormalOre D)ᵐᵒᵖ + +theorem derivationOre_rightHilbertBasis : + DerivationOreRightHilbertBasis.{u} := by + intro B _ hB D + let : IsNoetherianRing Bᵐᵒᵖ := hB + by_cases hnt : Nontrivial B + · let : Nontrivial B := hnt + exact normalOre_op_isNoetherian_of_nontrivial D + · have : Subsingleton B := not_nontrivial_iff_subsingleton.mp hnt + exact normalOre_op_isNoetherian_of_subsingleton D + +end + +end AlgebraicAnalysis.OreDerivationRightHilbertBasis diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightIntersection.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightIntersection.lean new file mode 100644 index 0000000000..6d954abbad --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightIntersection.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Module.Opposite +public import Mathlib.Algebra.Module.Submodule.Defs +public import Mathlib.Data.Finset.Insert +public import Mathlib.Tactic + + +/-! +# Finite intersections in a right Ore domain + +Right ideals are represented as left modules over the opposite ring. The +right Ore condition is kept as an explicit common-right-multiple hypothesis; +this module does not depend on a particular localization construction. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.OreRightIntersection + +variable {R : Type*} [Ring R] [IsDomain R] + +/-- Every pair of nonzero elements has a nonzero common right multiple. -/ +def RightOreCondition (R : Type*) [SemigroupWithZero R] : Prop := + ∀ ⦃a b : R⦄, a ≠ 0 → b ≠ 0 → + ∃ x y : R, a * x = b * y ∧ a * x ≠ 0 + +/-- A finite family of nonzero right ideals has a nonzero common element. + +The right ideals are left `Rᵐᵒᵖ`-submodules, so multiplying a member on the +right is expressed by scalar multiplication by `MulOpposite.op`. -/ +theorem exists_mem_finset_rightIdeals + {ι : Type*} + (s : Finset ι) (I : ι → Submodule Rᵐᵒᵖ R) + (hI : ∀ i ∈ s, ∃ x ∈ I i, x ≠ 0) + (hOre : RightOreCondition R) : + ∃ x : R, x ≠ 0 ∧ ∀ i ∈ s, x ∈ I i := by + classical + let : DecidableEq ι := Classical.decEq ι + classical + induction s using Finset.induction_on with + | empty => + exact ⟨1, one_ne_zero, by simp⟩ + | @insert i s hi ih => + obtain ⟨m, hm0, hm⟩ := ih (fun j hj => hI j (Finset.mem_insert_of_mem hj)) + obtain ⟨n, hnI, hn0⟩ := hI i (Finset.mem_insert_self i s) + obtain ⟨x, y, hxy, hmx0⟩ := hOre hm0 hn0 + refine ⟨m * x, hmx0, ?_⟩ + intro j hj + rcases Finset.mem_insert.mp hj with hji | hj + · subst j + rw [hxy] + exact (I i).smul_mem (MulOpposite.op y) hnI + · exact (I j).smul_mem (MulOpposite.op x) (hm j hj) + +/- The theorem is intentionally stated with an explicit nonzero witness; + this is the usual meaning of ``the intersection is nonzero''. -/ + +end AlgebraicAnalysis.OreRightIntersection diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightLocalization.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightLocalization.lean new file mode 100644 index 0000000000..afdfab67c3 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightLocalization.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.OreLocalization.Ring +public import Mathlib.Algebra.Ring.Opposite +public import Mathlib.Algebra.Group.Units.Opposite + + +/-! +# Right Ore localization + +The opposite-ring presentation of a right Ore localization and its +right-denominator clearing API. Extracted from Stafford38 commit +c8a513d553b24c7c08da82f496c44dbbaeb1f2fc. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.OreRightLocalization + +/-- The copy of `S` in the opposite ring. -/ +def oppositeSubmonoid {R : Type u} [Monoid R] (S : Submonoid R) : + Submonoid Rᵐᵒᵖ where + carrier := {x | x.unop ∈ S} + one_mem' := S.one_mem + mul_mem' := by + intro a b ha hb + exact S.mul_mem hb ha + +/-- The right Ore localization of `R`, implemented as the opposite of +Mathlib's left Ore localization of `Rᵐᵒᵖ`. -/ +abbrev RightOreLocalization (R : Type u) [Ring R] (S : Submonoid R) + [OreLocalization.OreSet (oppositeSubmonoid S)] := + (OreLocalization (oppositeSubmonoid S) (Rᵐᵒᵖ))ᵐᵒᵖ + +/-- The numerator map into the right Ore localization. -/ +def rightNumeratorRingHom + {R : Type u} [Ring R] {S : Submonoid R} + [OreLocalization.OreSet (oppositeSubmonoid S)] : + R →+* RightOreLocalization R S where + toFun r := MulOpposite.op + (OreLocalization.numeratorRingHom (S := oppositeSubmonoid S) (MulOpposite.op r)) + map_one' := by + apply MulOpposite.unop_injective + exact RingHom.map_one _ + map_zero' := by + apply MulOpposite.unop_injective + exact RingHom.map_zero _ + map_add' a b := by + apply MulOpposite.unop_injective + exact RingHom.map_add _ _ _ + map_mul' a b := by + apply MulOpposite.unop_injective + exact RingHom.map_mul _ (MulOpposite.op b) (MulOpposite.op a) + +/-- Every element of a right Ore localization has a right denominator in `S` +which is a unit and clears the fraction. -/ +theorem rightOre_clear + {R : Type u} [Ring R] {S : Submonoid R} + [OreLocalization.OreSet (oppositeSubmonoid S)] + (q : RightOreLocalization R S) : + ∃ a s : R, s ∈ S ∧ IsUnit (rightNumeratorRingHom (S := S) s) ∧ + q * rightNumeratorRingHom (S := S) s = rightNumeratorRingHom (S := S) a := by + generalize hx : q.unop = x + induction x using OreLocalization.ind with + | _ a s => + refine ⟨a.unop, s.val.unop, s.property, ?_, ?_⟩ + · exact isUnit_op.mpr (OreLocalization.numerator_isUnit + (R := Rᵐᵒᵖ) (S := oppositeSubmonoid S) s) + · apply MulOpposite.unop_injective + rw [show q = MulOpposite.op (a /ₒ s) by + apply MulOpposite.unop_injective + exact hx] + exact OreLocalization.mul_cancel (R := Rᵐᵒᵖ) + (S := oppositeSubmonoid S) (r := a) (s := s) (t := 1) + + +end AlgebraicAnalysis.OreRightLocalization diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightPBW.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightPBW.lean new file mode 100644 index 0000000000..300e81f507 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightPBW.lean @@ -0,0 +1,389 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightHilbertBasis +public import Mathlib.LinearAlgebra.Basis.Basic +public import Mathlib.LinearAlgebra.Finsupp.LinearCombination + + +/-! +# Right-coefficient PBW data for one derivation-Ore stage + +The checked Ore interface gives the opposite-ring right action and the +triangular coefficient identities. We prove directly that the candidate +monomials form a genuine right basis; the proof uses finite-support maximal +degree induction, so no freeness or flatness assumption is introduced. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.OreRightPBW + +open Polynomial +open Module +open AlgebraicAnalysis +open AlgebraicAnalysis.OreDivision +open AlgebraicAnalysis.OreAssociativity +open AlgebraicAnalysis.OreRightQuotient +open AlgebraicAnalysis.OreDerivationRightHilbertBasis + +noncomputable section + +universe u + +variable {B : Type u} [Ring B] + +/-- The candidate right-coefficient PBW monomial of order `n`. -/ +def rightPBWMonomial (D : OreDivisionDerivation B) (n : ℕ) : NormalOre D := + normalForm D (Polynomial.X ^ n) + +/-- The finitely supported right-coefficient combination of PBW monomials. -/ +def rightPBWCombination (D : OreDivisionDerivation B) : + (ℕ →₀ Bᵐᵒᵖ) →ₗ[Bᵐᵒᵖ] NormalOre D := + Finsupp.linearCombination Bᵐᵒᵖ (rightPBWMonomial D) + +lemma rightPBWCombination_single (D : OreDivisionDerivation B) + (n : ℕ) (b : Bᵐᵒᵖ) : + rightPBWCombination D (Finsupp.single n b) = + b • rightPBWMonomial D n := by + simp [rightPBWCombination] + +lemma rightPBWCombination_term_as_normalForm + (D : OreDivisionDerivation B) (n : ℕ) (b : Bᵐᵒᵖ) : + b • rightPBWMonomial D n = + normalForm D (OreDivision.rightMul D (Polynomial.X ^ n) + (Polynomial.C b.unop)) := by + rw [rightPBWMonomial, normalOre_op_smul_def, ← normalForm_C, + ← normalForm_mul] +lemma rightPBWCombination_finsupp_as_normalForm + (D : OreDivisionDerivation B) (c : ℕ →₀ Bᵐᵒᵖ) : + rightPBWCombination D c = + normalForm D + (c.sum fun n b => OreDivision.rightMul D (Polynomial.X ^ n) + (Polynomial.C b.unop)) := by + rw [rightPBWCombination, Finsupp.linearCombination_apply] + rw [Finsupp.sum] + rw [Finsupp.sum] + change _ = normalFormAddHom D + (∑ a ∈ c.support, + OreDivision.rightMul D (Polynomial.X ^ a) + (Polynomial.C (c a).unop)) + rw [map_sum] + apply Finset.sum_congr rfl + intro n b + exact rightPBWCombination_term_as_normalForm D n (c n) + +lemma rightPBWCombination_eq_zero + [Nontrivial B] (D : OreDivisionDerivation B) (c : ℕ →₀ Bᵐᵒᵖ) + (hc : rightPBWCombination D c = 0) : c = 0 := by + classical + by_contra hcz + have hne : c.support.Nonempty := Finsupp.support_nonempty_iff.mpr hcz + let m : ℕ := c.support.max' hne + have hm : m ∈ c.support := c.support.max'_mem hne + have hle : ∀ a ∈ c.support, a ≤ m := by + intro a ha + exact Finset.le_max' c.support a ha + have hpoly : + c.sum (fun n b => OreDivision.rightMul D (Polynomial.X ^ n) + (Polynomial.C b.unop)) = 0 := by + have hnf : + normalForm D + (c.sum (fun n b => OreDivision.rightMul D (Polynomial.X ^ n) + (Polynomial.C b.unop))) = 0 := by + rw [← rightPBWCombination_finsupp_as_normalForm D c] + exact hc + apply normalForm_injective D + simpa using hnf + have hcoeff := congrArg (fun p : Polynomial B => p.coeff m) hpoly + simp only [Finsupp.sum] at hcoeff + dsimp at hcoeff + rw [← Polynomial.lcoeff_apply, map_sum] at hcoeff + have hterm : ∀ a ∈ c.support, + (OreDivision.rightMul D (Polynomial.X ^ a) + (Polynomial.C (c a).unop)).coeff m = + if a = m then (c a).unop else 0 := by + intro a ha + have ha_le := hle a ha + have hdeg : (Polynomial.X ^ a : Polynomial B).degree ≤ + (m : WithBot ℕ) := by + rw [Polynomial.degree_X_pow] + exact_mod_cast ha_le + have htop := rightMul_coeff_C_of_degree_le D + (Polynomial.X ^ a) (c a).unop m hdeg + by_cases ham : a = m + · subst a + simpa using htop + · rw [htop] + have hcoeffX : (Polynomial.X ^ a : Polynomial B).coeff m = 0 := by + rw [Polynomial.coeff_X_pow] + split_ifs with h + · exact False.elim (ham h.symm) + · rfl + rw [hcoeffX, zero_mul] + simp [ham] + rw [Finset.sum_eq_single m (fun a ha hneam => by + exact hterm a ha |>.trans (by simp [hneam])) + (by intro hnot; exact False.elim (hnot hm))] at hcoeff + have hcm' : + (OreDivision.rightMul D (Polynomial.X ^ m) + (Polynomial.C (c m).unop)).coeff m = 0 := by + simpa [Polynomial.lcoeff_apply] using hcoeff + have hcm : c m = 0 := by + have htop := hterm m hm + rw [ite_eq_left rfl] at htop + have hcm'' : (c m).unop = 0 := by simpa [htop] using hcm' + exact MulOpposite.opEquiv.symm.injective hcm'' + exact (Finsupp.mem_support_iff.mp hm) hcm + +theorem rightPBWCombination_injective + [Nontrivial B] (D : OreDivisionDerivation B) : + Function.Injective (rightPBWCombination D) := by + intro c d h + have hz : rightPBWCombination D (c - d) = 0 := by + rw [map_sub, h, sub_self] + have hcd := rightPBWCombination_eq_zero D (c - d) hz + exact sub_eq_zero.mp hcd + +lemma rightPBWMonomial_mem_span (D : OreDivisionDerivation B) + (b : B) (n : ℕ) : + normalForm D (Polynomial.monomial n b) ∈ + Submodule.span Bᵐᵒᵖ (Set.range (rightPBWMonomial D)) := by + rw [normalForm_monomial_reverse] + apply Submodule.sum_mem + intro ij hij + rw [← Nat.cast_smul_eq_nsmul Bᵐᵒᵖ] + apply Submodule.smul_mem + have hpow : rightPBWMonomial D ij.2 ∈ + Submodule.span Bᵐᵒᵖ (Set.range (rightPBWMonomial D)) := by + apply Submodule.subset_span + exact ⟨ij.2, rfl⟩ + have hscalar : (MulOpposite.op ((D^[ij.1]) b)) • + rightPBWMonomial D ij.2 ∈ + Submodule.span Bᵐᵒᵖ (Set.range (rightPBWMonomial D)) := + Submodule.smul_mem _ _ hpow + by_cases heven : Even ij.1 + · rw [heven.neg_one_pow] + simpa only [one_mul, rightPBWMonomial] using hscalar + · have hodd : Odd ij.1 := Nat.not_even_iff_odd.mp heven + rw [hodd.neg_one_pow] + simpa only [neg_one_mul, rightPBWMonomial] using + (Submodule.span Bᵐᵒᵖ (Set.range (rightPBWMonomial D))).neg_mem hscalar + +theorem rightPBW_span_eq_top (D : OreDivisionDerivation B) : + Submodule.span Bᵐᵒᵖ (Set.range (rightPBWMonomial D)) = ⊤ := by + apply top_unique + intro z hz + obtain ⟨p, rfl⟩ := normalForm_surjective D z + change normalFormAddHom D p ∈ _ + rw [← Polynomial.sum_monomial_eq p, Polynomial.sum_def, + map_sum (normalFormAddHom D)] + apply Submodule.sum_mem + intro n hn + exact rightPBWMonomial_mem_span D (p.coeff n) n + +theorem rightOrePBW_linearIndependent + [Nontrivial B] (D : OreDivisionDerivation B) : + LinearIndependent Bᵐᵒᵖ (rightPBWMonomial D) := + (linearIndependent_iff_injective_finsuppLinearCombination).2 + (rightPBWCombination_injective D) + +/-- The right PBW basis of a one-stage derivation-Ore extension. -/ +def rightOrePBWBasis [Nontrivial B] (D : OreDivisionDerivation B) : + Basis ℕ Bᵐᵒᵖ (NormalOre D) := + Basis.mk (rightOrePBW_linearIndependent D) + (rightPBW_span_eq_top D).ge + +@[simp] +theorem rightOrePBWBasis_apply [Nontrivial B] + (D : OreDivisionDerivation B) (n : ℕ) : + rightOrePBWBasis D n = rightPBWMonomial D n := by + exact Basis.mk_apply _ _ _ + +theorem rightOrePBWBasis_repr_symm_single [Nontrivial B] + (D : OreDivisionDerivation B) (n : ℕ) (b : Bᵐᵒᵖ) : + (rightOrePBWBasis D).repr.symm (Finsupp.single n b) = + b • rightPBWMonomial D n := by + rw [(rightOrePBWBasis D).repr_symm_single, rightOrePBWBasis_apply] + +theorem rightPBWMonomial_zero (D : OreDivisionDerivation B) : + rightPBWMonomial D 0 = 1 := by + simp [rightPBWMonomial, normalForm_one] + +@[simp] +theorem rightPBWMonomial_op_smul + (D : OreDivisionDerivation B) (b : Bᵐᵒᵖ) (n : ℕ) : + b • rightPBWMonomial D n = + normalForm D (Polynomial.X ^ n) * normalCoefficient D b.unop := by + exact normalOre_op_smul_def D b (rightPBWMonomial D n) + +/-- The finite window generated by the candidate right PBW monomials. -/ +def rightPBWWindow (D : OreDivisionDerivation B) (n : ℕ) : + Submodule Bᵐᵒᵖ (NormalOre D) := + Submodule.span Bᵐᵒᵖ + (Set.range fun j : Fin n => rightPBWMonomial D (j : ℕ)) + +theorem normalForm_mem_rightPBWWindow_of_degree_lt + (D : OreDivisionDerivation B) (p : Polynomial B) (n : ℕ) + (hp : p = 0 ∨ p.natDegree < n) : + normalForm D p ∈ rightPBWWindow D n := by + simpa [rightPBWWindow, rightPBWMonomial, rightCoefficientWindow] using + (normalForm_mem_rightCoefficientWindow_of_degree_lt D p n hp) +theorem rightPBWWindow_finite + (D : OreDivisionDerivation B) (n : ℕ) : + Module.Finite Bᵐᵒᵖ (rightPBWWindow D n) := by + exact Module.Finite.span_of_finite Bᵐᵒᵖ + (Set.finite_range (fun j : Fin n => rightPBWMonomial D (j : ℕ))) + +@[simp] +theorem rightPBWMonomial_apply (D : OreDivisionDerivation B) (n : ℕ) : + rightPBWMonomial D n = normalForm D (Polynomial.X ^ n) := rfl + +/-- Right multiplication by a PBW monomial has the expected top coefficient. +This is the triangular input for an eventual basis proof. -/ +theorem rightMul_Xpow_top_coefficient + [Nontrivial B] (D : OreDivisionDerivation B) (p : Polynomial B) + (n j : ℕ) (hp : p.degree ≤ (n : WithBot ℕ)) : + (rightMul D p (Polynomial.X ^ j)).coeff (n + j) = p.coeff n := by + exact rightMul_Xpow_coeff_of_degree_le D p n j hp + +theorem rightMul_Xpow_degree_le + [Nontrivial B] + (D : OreDivisionDerivation B) (p : Polynomial B) (j : ℕ) : + (rightMul D p (Polynomial.X ^ j)).degree ≤ + (p.natDegree + j : WithBot ℕ) := by + have h := rightMul_degree_le D p (Polynomial.X ^ j) + have hX : (Polynomial.X ^ j : Polynomial B).natDegree = j := by + exact Polynomial.natDegree_X_pow _ + rw [hX] at h + exact h + +/-! ## Monic principal quotients -/ + +/-- A vector in the first `N` right-PBW slots has a coefficient-left normal +form of degree strictly less than `N`. This is the converse, at the level +needed for division, of `normalForm_mem_rightPBWWindow_of_degree_lt`. -/ +theorem exists_lowDegreePolynomial_eq_of_mem_rightPBWWindow + [Nontrivial B] (D : OreDivisionDerivation B) (N : ℕ) + {z : NormalOre D} (hz : z ∈ rightPBWWindow D N) : + ∃ r : Polynomial B, + (r = 0 ∨ r.natDegree < N) ∧ normalForm D r = z := by + change z ∈ Submodule.span Bᵐᵒᵖ + (Set.range fun j : Fin N ↦ normalForm D (Polynomial.X ^ (j : ℕ))) at hz + obtain ⟨c, hc⟩ := (Submodule.mem_span_range_iff_exists_fun Bᵐᵒᵖ).mp hz + let r : Polynomial B := ∑ j : Fin N, + rightMul D (Polynomial.X ^ (j : ℕ)) (Polynomial.C (c j).unop) + refine ⟨r, ?_, ?_⟩ + · by_cases hr : r = 0 + · exact Or.inl hr + · exact Or.inr ((Polynomial.natDegree_lt_iff_degree_lt hr).mpr (by + rw [Polynomial.degree_lt_iff_coeff_zero] + intro m hm + change (Polynomial.lcoeff B m) (∑ j : Fin N, + rightMul D (Polynomial.X ^ (j : ℕ)) + (Polynomial.C (c j).unop)) = 0 + rw [map_sum] + apply Finset.sum_eq_zero + intro j hj + apply Polynomial.coeff_eq_zero_of_degree_lt + have hdeg := rightMul_degree_le D + (Polynomial.X ^ (j : ℕ)) (Polynomial.C (c j).unop) + rw [Polynomial.natDegree_X_pow, Polynomial.natDegree_C] at hdeg + exact lt_of_le_of_lt hdeg (by exact_mod_cast j.isLt.trans_le hm))) + · change normalFormAddHom D (∑ j : Fin N, + rightMul D (Polynomial.X ^ (j : ℕ)) + (Polynomial.C (c j).unop)) = z + rw [map_sum, ← hc] + apply Finset.sum_congr rfl + intro j hj + change normalForm D (rightMul D (Polynomial.X ^ (j : ℕ)) + (Polynomial.C (c j).unop)) = _ + rw [normalForm_mul] + simp only [normalForm_C, normalOre_op_smul_def] + +/-- Monic right multiples and the finite right-PBW remainder window are exact +complements. Equivalently, monic right division is both exhaustive and +unique as a decomposition over the opposite coefficient ring. -/ +theorem monicPrincipalRightIdeal_isCompl_rightPBWWindow + [Nontrivial B] (D : OreDivisionDerivation B) + (H : Polynomial B) (hH : H.Monic) : + IsCompl (twoGeneratorCoeffSubmodule D H 0) + (rightPBWWindow D H.natDegree) := by + apply IsCompl.of_le + · intro z hz + have hzI := hz.1 + have hzW := hz.2 + change z ∈ twoGeneratorRightIdeal D H 0 at hzI + rw [twoGeneratorRightIdeal, Submodule.mem_span_pair] at hzI + obtain ⟨a, b, hab⟩ := hzI + have hzeroTerm : b • normalForm D (0 : Polynomial B) = 0 := by + rw [normalForm_zero, smul_zero] + rw [hzeroTerm, add_zero] at hab + change normalForm D H * a.unop = z at hab + obtain ⟨q, hq⟩ := normalForm_surjective D a.unop + obtain ⟨r, hrsmall, hrz⟩ := + exists_lowDegreePolynomial_eq_of_mem_rightPBWWindow D H.natDegree hzW + have hdecomp : r = rightMul D H q + 0 := by + apply normalForm_injective D + rw [normalForm_add, normalForm_zero, normalForm_mul, add_zero, hq] + exact hrz.trans hab.symm + have hzero := (right_division_unique D H r q 0 0 r hH + hdecomp (by simp [rightMul_zero]) (Or.inl rfl) hrsmall).2 + have hr0 : r = 0 := hzero.symm + rw [← hrz, hr0, normalForm_zero] + exact Submodule.zero_mem _ + · intro z hz + obtain ⟨p, rfl⟩ := normalForm_surjective D z + obtain ⟨q, r, hdecomp, hrsmall⟩ := right_division_exists D H p hH + rw [Submodule.mem_sup] + refine ⟨normalForm D (rightMul D H q), + normalForm_rightMul_H_mem_twoGeneratorCoeffSubmodule D H 0 q, + normalForm D r, + normalForm_mem_rightPBWWindow_of_degree_lt D r H.natDegree hrsmall, + ?_⟩ + rw [← normalForm_add, ← hdecomp] + +/-- The basis of the finite right-PBW remainder window. -/ +def rightPBWWindowBasis [Nontrivial B] + (D : OreDivisionDerivation B) (N : ℕ) : + Basis (Fin N) Bᵐᵒᵖ (rightPBWWindow D N) := + Basis.span ((rightOrePBW_linearIndependent D).comp + (fun j : Fin N ↦ (j : ℕ)) Fin.val_injective) + +/-- A monic principal right quotient of a derivation-Ore extension is free of +rank `H.natDegree` over the opposite coefficient ring, with basis represented +by `1, X, …, X^(H.natDegree-1)`. The `0` second generator is only a literal +encoding of the principal right ideal inside the existing quotient API. -/ +def monicPrincipalRightQuotientBasis [Nontrivial B] + (D : OreDivisionDerivation B) (H : Polynomial B) (hH : H.Monic) : + Basis (Fin H.natDegree) Bᵐᵒᵖ (TwoGeneratorQuotient D H 0) := + (rightPBWWindowBasis D H.natDegree).map + (Submodule.quotientEquivOfIsCompl + (twoGeneratorCoeffSubmodule D H 0) + (rightPBWWindow D H.natDegree) + (monicPrincipalRightIdeal_isCompl_rightPBWWindow D H hH)).symm + +@[simp] +theorem monicPrincipalRightQuotientBasis_apply [Nontrivial B] + (D : OreDivisionDerivation B) (H : Polynomial B) (hH : H.Monic) + (j : Fin H.natDegree) : + monicPrincipalRightQuotientBasis D H hH j = + Submodule.Quotient.mk (normalForm D (Polynomial.X ^ (j : ℕ))) := by + rw [monicPrincipalRightQuotientBasis, Basis.map_apply, + Submodule.quotientEquivOfIsCompl_symm_apply] + congr 1 + change (((rightPBWWindowBasis D H.natDegree) j : + rightPBWWindow D H.natDegree) : NormalOre D) = + normalForm D (Polynomial.X ^ (j : ℕ)) + exact congrArg Subtype.val + (Basis.span_apply ((rightOrePBW_linearIndependent D).comp + (fun j : Fin H.natDegree ↦ (j : ℕ)) Fin.val_injective) j) + + +end +end AlgebraicAnalysis.OreRightPBW diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightQuotient.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightQuotient.lean new file mode 100644 index 0000000000..922eb88689 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/RightQuotient.lean @@ -0,0 +1,276 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.Associativity + + +/-! +# Finite right quotients over noncommutative Ore coefficients + +Monic right division leaves coefficient-left remainders. A signed reverse +normal-ordering identity rewrites them in a finite right-coefficient window. +The natural scalar ring is therefore `Bᵐᵒᵖ`, not `B`; this removes the +commutativity restriction from the older finite-quotient consumer. + +The final section instantiates the construction on the outer momentum layer +of the iterated Weyl tower and uses the literal generators `d` and `x^N d`. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.OreRightQuotient + +open Polynomial +open AlgebraicAnalysis +open AlgebraicAnalysis.OreDivision +open AlgebraicAnalysis.OreAssociativity + +noncomputable section + +variable {B : Type*} [Ring B] + +instance normalOreNontrivial [Nontrivial B] (D : OreDivisionDerivation B) : + Nontrivial (NormalOre D) := by + refine ⟨⟨0, 1, ?_⟩⟩ + intro h + have h' : normalForm D (0 : Polynomial B) = normalForm D 1 := by + rw [normalForm_zero, normalForm_one] + exact h + exact zero_ne_one (normalForm_injective D h') + +theorem normalCoefficient_injective (D : OreDivisionDerivation B) : + Function.Injective (normalCoefficient D) := by + intro a b h + apply Polynomial.C_injective + apply normalForm_injective D + simpa only [normalForm_C] using h + +instance normalOreOpSMul (D : OreDivisionDerivation B) : + SMul Bᵐᵒᵖ (NormalOre D) := + ⟨fun b a => a * normalCoefficient D b.unop⟩ + +instance normalOreOpModule (D : OreDivisionDerivation B) : + Module Bᵐᵒᵖ (NormalOre D) := + Module.ofMinimalAxioms + (fun b x y => by + change (x + y) * normalCoefficient D b.unop = + x * normalCoefficient D b.unop + y * normalCoefficient D b.unop + exact add_mul x y (normalCoefficient D b.unop)) + (fun b c x => by + change x * normalCoefficient D (b + c).unop = + x * normalCoefficient D b.unop + x * normalCoefficient D c.unop + rw [MulOpposite.unop_add, (normalCoefficient D).map_add, mul_add]) + (fun b c x => by + change x * normalCoefficient D (b * c).unop = + (x * normalCoefficient D c.unop) * normalCoefficient D b.unop + rw [MulOpposite.unop_mul, (normalCoefficient D).map_mul, mul_assoc]) + (fun x => by + change x * normalCoefficient D (1 : Bᵐᵒᵖ).unop = x + rw [MulOpposite.unop_one, (normalCoefficient D).map_one, mul_one]) + +@[simp] +theorem normalOre_op_smul_def (D : OreDivisionDerivation B) + (b : Bᵐᵒᵖ) (a : NormalOre D) : + b • a = a * normalCoefficient D b.unop := rfl + +@[simp] +theorem normalForm_X_pow_coe (D : OreDivisionDerivation B) (n : ℕ) : + (normalForm D (X ^ n) : AddMonoid.End (Polynomial B)) = + (leftOreShift D) ^ n := by + change OreAmbient.eval D (faithfulAmbient D) (X ^ n) = _ + rw [Polynomial.X_pow_eq_monomial, OreAmbient.eval_monomial] + simp [faithfulAmbient] + +theorem normalForm_monomial_reverse (D : OreDivisionDerivation B) + (b : B) (n : ℕ) : + normalForm D (monomial n b) = + ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + n.choose ij.1 • + ((-1 : NormalOre D) ^ ij.1 * + ((MulOpposite.op ((D^[ij.1]) b)) • + normalForm D (X ^ ij.2))) := by + apply Subtype.ext + change OreAmbient.eval D (faithfulAmbient D) (monomial n b) = _ + rw [OreAmbient.eval_monomial] + rw [OreAmbient.reverse_mul D (faithfulAmbient D) b n] + unfold OreAmbient.reverseExpansion OreAmbient.reverseSignedTerm + OreAmbient.reverseTerm + change _ = (faithfulRange D).subtype + (∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + n.choose ij.1 • + ((-1 : NormalOre D) ^ ij.1 * + ((MulOpposite.op ((D^[ij.1]) b)) • + normalForm D (X ^ ij.2)))) + have hsum : + (faithfulRange D).subtype + (∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + n.choose ij.1 • + ((-1 : NormalOre D) ^ ij.1 * + ((MulOpposite.op ((D^[ij.1]) b)) • + normalForm D (X ^ ij.2)))) = + ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + (faithfulRange D).subtype + (n.choose ij.1 • + ((-1 : NormalOre D) ^ ij.1 * + ((MulOpposite.op ((D^[ij.1]) b)) • + normalForm D (X ^ ij.2)))) := by + exact map_sum (faithfulRange D).subtype.toAddMonoidHom _ _ + rw [hsum] + apply Finset.sum_congr rfl + intro ij hij + change + n.choose ij.1 • + ((-1 : AddMonoid.End (Polynomial B)) ^ ij.1 * + ((leftOreShift D) ^ ij.2 * coefficientLeft ((D^[ij.1]) b))) = + n.choose ij.1 • + ((((-1 : NormalOre D) ^ ij.1 * + ((MulOpposite.op ((D^[ij.1]) b)) • + normalForm D (X ^ ij.2))) : NormalOre D) : + AddMonoid.End (Polynomial B)) + apply congrArg (fun z : AddMonoid.End (Polynomial B) => n.choose ij.1 • z) + simp only [normalOre_op_smul_def] + change + (-1 : AddMonoid.End (Polynomial B)) ^ ij.1 * + ((leftOreShift D) ^ ij.2 * coefficientLeft ((D^[ij.1]) b)) = + (-1 : AddMonoid.End (Polynomial B)) ^ ij.1 * + (((normalForm D (X ^ ij.2) : NormalOre D) : + AddMonoid.End (Polynomial B)) * coefficientLeft ((D^[ij.1]) b)) + rw [normalForm_X_pow_coe] + +/-- The finite right-coefficient window of order less than `n`. -/ +def rightCoefficientWindow (D : OreDivisionDerivation B) (n : ℕ) : + Submodule Bᵐᵒᵖ (NormalOre D) := + Submodule.span Bᵐᵒᵖ + (Set.range fun j : Fin n => normalForm D (X ^ (j : ℕ))) + +lemma normalForm_monomial_mem_rightCoefficientWindow + (D : OreDivisionDerivation B) (b : B) {j n : ℕ} (hj : j < n) : + normalForm D (monomial j b) ∈ rightCoefficientWindow D n := by + rw [normalForm_monomial_reverse] + apply Submodule.sum_mem + intro ij hij + rw [← Nat.cast_smul_eq_nsmul Bᵐᵒᵖ] + apply Submodule.smul_mem + have hijSum : ij.1 + ij.2 = j := + Finset.HasAntidiagonal.mem_antidiagonal.mp hij + have hijLt : ij.2 < n := by omega + have hpow : normalForm D (X ^ ij.2) ∈ rightCoefficientWindow D n := by + apply Submodule.subset_span + exact ⟨⟨ij.2, hijLt⟩, rfl⟩ + have hscalar : + (MulOpposite.op ((D^[ij.1]) b)) • normalForm D (X ^ ij.2) ∈ + rightCoefficientWindow D n := + Submodule.smul_mem _ _ hpow + by_cases heven : Even ij.1 + · rw [heven.neg_one_pow] + simpa only [one_mul] using hscalar + · have hodd : Odd ij.1 := Nat.not_even_iff_odd.mp heven + rw [hodd.neg_one_pow] + simpa only [neg_one_mul] using + (rightCoefficientWindow D n).neg_mem hscalar + +theorem normalForm_mem_rightCoefficientWindow_of_degree_lt + (D : OreDivisionDerivation B) (p : Polynomial B) (n : ℕ) + (hp : p = 0 ∨ p.natDegree < n) : + normalForm D p ∈ rightCoefficientWindow D n := by + rcases hp with rfl | hp + · simp + · change normalFormAddHom D p ∈ rightCoefficientWindow D n + rw [← Polynomial.sum_monomial_eq p, Polynomial.sum_def, + map_sum (normalFormAddHom D)] + apply Submodule.sum_mem + intro j hj + apply normalForm_monomial_mem_rightCoefficientWindow D + exact lt_of_le_of_lt (Polynomial.le_natDegree_of_mem_supp j hj) hp + +/-- A right ideal viewed as a coefficient-opposite submodule. -/ +def rightIdealAsCoeffSubmodule (D : OreDivisionDerivation B) + (I : Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D)) : + Submodule Bᵐᵒᵖ (NormalOre D) where + carrier := I + zero_mem' := I.zero_mem + add_mem' := I.add_mem + smul_mem' := by + intro b a ha + change a * normalCoefficient D b.unop ∈ I + rw [← op_smul_eq_mul] + exact I.smul_mem (MulOpposite.op (normalCoefficient D b.unop)) ha + +/-- The right ideal generated by two normal forms. -/ +def twoGeneratorRightIdeal (D : OreDivisionDerivation B) + (H J : Polynomial B) : + Submodule (NormalOre D)ᵐᵒᵖ (NormalOre D) := + Submodule.span (NormalOre D)ᵐᵒᵖ + ({normalForm D H, normalForm D J} : Set (NormalOre D)) + +/-- The coefficient-opposite submodule underlying a two-generator ideal. -/ +def twoGeneratorCoeffSubmodule (D : OreDivisionDerivation B) + (H J : Polynomial B) : Submodule Bᵐᵒᵖ (NormalOre D) := + rightIdealAsCoeffSubmodule D (twoGeneratorRightIdeal D H J) + +/-- The corresponding quotient as a coefficient-opposite module. -/ +abbrev TwoGeneratorQuotient (D : OreDivisionDerivation B) + (H J : Polynomial B) := + NormalOre D ⧸ twoGeneratorCoeffSubmodule D H J + +lemma normalForm_H_mem_twoGeneratorRightIdeal + (D : OreDivisionDerivation B) (H J : Polynomial B) : + normalForm D H ∈ twoGeneratorRightIdeal D H J := by + apply Submodule.subset_span + simp + +lemma normalForm_rightMul_H_mem_twoGeneratorCoeffSubmodule + (D : OreDivisionDerivation B) (H J q : Polynomial B) : + normalForm D (rightMul D H q) ∈ + twoGeneratorCoeffSubmodule D H J := by + change normalForm D (rightMul D H q) ∈ twoGeneratorRightIdeal D H J + rw [normalForm_mul, ← op_smul_eq_mul] + exact (twoGeneratorRightIdeal D H J).smul_mem + (MulOpposite.op (normalForm D q)) + (normalForm_H_mem_twoGeneratorRightIdeal D H J) + +theorem rightCoefficientWindow_quotient_surjective + [Nontrivial B] (D : OreDivisionDerivation B) + (H J : Polynomial B) (hH : H.Monic) : + Function.Surjective + ((twoGeneratorCoeffSubmodule D H J).mkQ.comp + (rightCoefficientWindow D H.natDegree).subtype) := by + intro y + obtain ⟨a, rfl⟩ := + (twoGeneratorCoeffSubmodule D H J).mkQ_surjective y + obtain ⟨p, rfl⟩ := normalForm_surjective D a + obtain ⟨q, r, hdecomp, hr⟩ := right_division_exists D H p hH + have hrWindow : normalForm D r ∈ + rightCoefficientWindow D H.natDegree := + normalForm_mem_rightCoefficientWindow_of_degree_lt D r H.natDegree hr + refine ⟨⟨normalForm D r, hrWindow⟩, ?_⟩ + change (twoGeneratorCoeffSubmodule D H J).mkQ (normalForm D r) = + (twoGeneratorCoeffSubmodule D H J).mkQ (normalForm D p) + apply (Submodule.Quotient.eq (twoGeneratorCoeffSubmodule D H J)).2 + have hmultiple : normalForm D (rightMul D H q) ∈ + twoGeneratorCoeffSubmodule D H J := + normalForm_rightMul_H_mem_twoGeneratorCoeffSubmodule D H J q + rw [hdecomp, normalForm_add] + simpa using (twoGeneratorCoeffSubmodule D H J).neg_mem hmultiple + +theorem twoGeneratorQuotient_finite + [Nontrivial B] (D : OreDivisionDerivation B) + (H J : Polynomial B) (hH : H.Monic) : + Module.Finite Bᵐᵒᵖ (TwoGeneratorQuotient D H J) := by + let : Module.Finite Bᵐᵒᵖ (rightCoefficientWindow D H.natDegree) := + Module.Finite.span_of_finite Bᵐᵒᵖ (Set.finite_range + (fun j : Fin H.natDegree => normalForm D (X ^ (j : ℕ)))) + exact Module.Finite.of_surjective + ((twoGeneratorCoeffSubmodule D H J).mkQ.comp + (rightCoefficientWindow D H.natDegree).subtype) + (rightCoefficientWindow_quotient_surjective D H J hH) + + + +end +end AlgebraicAnalysis.OreRightQuotient diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Ore/Tower.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/Tower.lean new file mode 100644 index 0000000000..fa54b966fc --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Ore/Tower.lean @@ -0,0 +1,195 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.LeftPBW + + +/-! +# Commuting derivations and the next Ore stage + +This file contains the coefficientwise lift needed in the iterated Ore tower. +If two coefficient derivations commute, the second one extends through the +first derivation-Ore extension by differentiating every coefficient in left +normal form. The formulas at the coefficient embedding and at the Ore +variable are part of the interface used by later tower stages. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.OreTower + +open Polynomial +open AlgebraicAnalysis +open AlgebraicAnalysis.OreDivision +open AlgebraicAnalysis.OreAssociativity + +noncomputable section + + +variable {B : Type*} [Ring B] + +/-! ## Commuting iterates -/ + +lemma iterate_apply_commute (D E : OreDivisionDerivation B) + (hcomm : ∀ b : B, D (E b) = E (D b)) (n : ℕ) (b : B) : + E ((D^[n]) b) = (D^[n]) (E b) := by + induction n with + | zero => rfl + | succ n ih => + rw [Function.iterate_succ_apply', Function.iterate_succ_apply'] + calc + E (D ((D^[n]) b)) = D (E ((D^[n]) b)) := (hcomm _).symm + _ = D ((D^[n]) (E b)) := congrArg D ih + +lemma coefficientDerivation_commute (E F : OreDivisionDerivation B) + (hcomm : ∀ b : B, E (F b) = F (E b)) (p : Polynomial B) : + coefficientDerivation E (coefficientDerivation F p) = + coefficientDerivation F (coefficientDerivation E p) := by + induction p using Polynomial.induction_on' with + | add p q hp hq => + rw [map_add, map_add, map_add, map_add, hp, hq] + | monomial i b => + rw [coefficientDerivation_monomial, coefficientDerivation_monomial, + coefficientDerivation_monomial, coefficientDerivation_monomial, + hcomm] + +lemma coefficientDerivation_rightTerm (D E : OreDivisionDerivation B) + (hcomm : ∀ b : B, D (E b) = E (D b)) + (i : ℕ) (a b : B) (j : ℕ) : + coefficientDerivation E (rightTerm D i a b j) = + rightTerm D i (E a) b j + rightTerm D i a (E b) j := by + rw [rightTerm] + simp only [map_sum, coefficientDerivation_monomial] + simp only [rightTerm] + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro k hk + rw [OreDivisionDerivation.leibniz] + rw [OreDivisionDerivation.map_nsmul] + rw [iterate_apply_commute D E hcomm] + rw [map_add] + exact add_comm _ _ + +lemma coefficientDerivation_rightMulMonomial (D E : OreDivisionDerivation B) + (hcomm : ∀ b : B, D (E b) = E (D b)) (p : Polynomial B) + (b : B) (j : ℕ) : + coefficientDerivation E (rightMulMonomial D p b j) = + rightMulMonomial D (coefficientDerivation E p) b j + + rightMulMonomial D p (E b) j := by + induction p using Polynomial.induction_on' with + | add p q hp hq => + rw [rightMulMonomial_add_left, map_add, hp, hq, map_add, + rightMulMonomial_add_left D p q (E b) j] + rw [rightMulMonomial_add_left D (coefficientDerivation E p) + (coefficientDerivation E q) b j] + abel + | monomial i a => + simp only [rightMulMonomial, rightTerm_zero, sum_monomial_index, + coefficientDerivation_monomial] + exact coefficientDerivation_rightTerm D E hcomm i a b j + +lemma coefficientDerivation_rightMul (D E : OreDivisionDerivation B) + (hcomm : ∀ b : B, D (E b) = E (D b)) (p q : Polynomial B) : + coefficientDerivation E (rightMul D p q) = + rightMul D (coefficientDerivation E p) q + + rightMul D p (coefficientDerivation E q) := by + induction q using Polynomial.induction_on' with + | add q r hq hr => + rw [rightMul_add, map_add, hq, hr, map_add, rightMul_add, rightMul_add] + abel + | monomial j b => + simp only [rightMul_monomial, coefficientDerivation_monomial] + exact coefficientDerivation_rightMulMonomial D E hcomm p b j + +/-! ## The lifted derivation -/ + +/-- Differentiate the coefficients of a left-normal Ore polynomial. -/ +def liftDerivation (D E : OreDivisionDerivation B) + (hcomm : ∀ b : B, D (E b) = E (D b)) : + OreDivisionDerivation (NormalOre D) where + toFun z := + normalForm D (coefficientDerivation E + ((normalFormAddEquiv D).symm z)) + map_zero' := by + change normalForm D (coefficientDerivation E + ((normalFormAddEquiv D).symm 0)) = 0 + rw [(normalFormAddEquiv D).symm.map_zero, map_zero, normalForm_zero] + map_add' z w := by + have h := (normalFormAddEquiv D).symm.toAddHom.map_add z w + change (normalFormAddEquiv D).symm (z + w) = + (normalFormAddEquiv D).symm z + (normalFormAddEquiv D).symm w at h + change normalForm D (coefficientDerivation E + ((normalFormAddEquiv D).symm (z + w))) = _ + rw [h, map_add, normalForm_add] + leibniz' := by + intro z w + rcases normalForm_surjective D z with ⟨p, rfl⟩ + rcases normalForm_surjective D w with ⟨q, rfl⟩ + rw [← normalForm_mul] + have hs (r : Polynomial B) : + (normalFormAddEquiv D).symm (normalForm D r) = r := by + change (normalFormAddEquiv D).symm ((normalFormAddEquiv D) r) = r + exact (normalFormAddEquiv D).symm_apply_apply r + rw [hs, hs, hs] + rw [coefficientDerivation_rightMul D E hcomm] + rw [normalForm_add, normalForm_mul, normalForm_mul] + rw [add_comm] + +@[simp] +theorem liftDerivation_apply_normalForm + (D E : OreDivisionDerivation B) + (hcomm : ∀ b : B, D (E b) = E (D b)) (p : Polynomial B) : + liftDerivation D E hcomm (normalForm D p) = + normalForm D (coefficientDerivation E p) := by + change normalForm D (coefficientDerivation E + ((normalFormAddEquiv D).symm (normalForm D p))) = + normalForm D (coefficientDerivation E p) + have hs : (normalFormAddEquiv D).symm (normalForm D p) = p := by + change (normalFormAddEquiv D).symm ((normalFormAddEquiv D) p) = p + exact (normalFormAddEquiv D).symm_apply_apply p + rw [hs] + +@[simp] +theorem liftDerivation_apply_coefficient (D E : OreDivisionDerivation B) + (hcomm : ∀ b : B, D (E b) = E (D b)) (b : B) : + liftDerivation D E hcomm (normalCoefficient D b) = + normalCoefficient D (E b) := by + rw [← normalForm_C, ← normalForm_C] + change normalForm D (coefficientDerivation E + ((normalFormAddEquiv D).symm ((normalFormAddEquiv D) (C b)))) = + normalForm D (C (E b)) + rw [(normalFormAddEquiv D).symm_apply_apply] + rw [← monomial_zero_left, coefficientDerivation_monomial] + rw [monomial_zero_left, normalForm_C] + +@[simp] +theorem liftDerivation_apply_variable (D E : OreDivisionDerivation B) + (hcomm : ∀ b : B, D (E b) = E (D b)) : + liftDerivation D E hcomm (normalVariable D) = 0 := by + change normalForm D (coefficientDerivation E + ((normalFormAddEquiv D).symm ((normalFormAddEquiv D) Polynomial.X))) = 0 + rw [(normalFormAddEquiv D).symm_apply_apply] + rw [← Polynomial.monomial_one_one_eq_X, coefficientDerivation_monomial, + derivation_one E, monomial_zero_right, + normalForm_zero] + +theorem liftDerivation_commute + (D E F : OreDivisionDerivation B) + (hDE : ∀ b : B, D (E b) = E (D b)) + (hDF : ∀ b : B, D (F b) = F (D b)) + (hEF : ∀ b : B, E (F b) = F (E b)) (z : NormalOre D) : + liftDerivation D E hDE (liftDerivation D F hDF z) = + liftDerivation D F hDF (liftDerivation D E hDE z) := by + rcases normalForm_surjective D z with ⟨p, rfl⟩ + rw [liftDerivation_apply_normalForm, liftDerivation_apply_normalForm, + liftDerivation_apply_normalForm, liftDerivation_apply_normalForm, + coefficientDerivation_commute E F hEF] + + +end +end AlgebraicAnalysis.OreTower diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/Polynomial/DistinguishedVariable.lean b/LeanPool/Stafford38/AlgebraicAnalysis/Polynomial/DistinguishedVariable.lean new file mode 100644 index 0000000000..70d7b340e8 --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/Polynomial/DistinguishedVariable.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.MvPolynomial.Variables +public import Mathlib.RingTheory.Ideal.Prime +public import Mathlib.RingTheory.MvPolynomial.Homogeneous +public import Mathlib.RingTheory.MvPolynomial.Ideal + + +/-! +# A distinguished variable in a homogeneous prime relation + +If a homogeneous polynomial uses one distinguished variable together with a +set of auxiliary variables, then subtracting its pure distinguished monomial +puts it in the ideal generated by the auxiliary variables. Consequently, a +prime containing the polynomial and every auxiliary variable also contains +the distinguished variable, provided the pure coefficient is a unit. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis.MvPolynomial + +open scoped BigOperators + +variable {R σ : Type*} [CommRing R] + +/-- Removing the pure distinguished monomial from a homogeneous polynomial +leaves an element of the ideal generated by its other allowed variables. -/ +theorem sub_pureMonomial_mem_span_X + {P : MvPolynomial σ R} {N : ℕ} {t : σ} {s : Set σ} {c : R} + (hP : P.IsHomogeneous N) + (hvars : (P.vars : Set σ) ⊆ insert t s) + (hcoeff : P.coeff (Finsupp.single t N) = c) : + P - MvPolynomial.monomial (Finsupp.single t N) c ∈ + Ideal.span (MvPolynomial.X '' s : Set (MvPolynomial σ R)) := by + classical + rw [MvPolynomial.mem_ideal_span_X_image] + intro m hm + by_contra haux + push Not at haux + have hdiff : + (P - MvPolynomial.monomial (Finsupp.single t N) c).coeff m ≠ 0 := + MvPolynomial.mem_support_iff.mp hm + by_cases hmt : m = Finsupp.single t N + · subst m + simp [hcoeff] at hdiff + have hmono : + (MvPolynomial.monomial (Finsupp.single t N) c).coeff m = 0 := by + simp [MvPolynomial.coeff_monomial, Ne.symm hmt] + have hmP : m ∈ P.support := by + apply MvPolynomial.mem_support_iff.mpr + simpa [hmono] using hdiff + have hsupp : m.support ⊆ {t} := by + intro i hi + have hiVars : i ∈ P.vars := + (MvPolynomial.mem_vars_iff_mem_support i).mpr ⟨m, hmP, hi⟩ + have hiAllowed : i = t ∨ i ∈ s := by + simpa only [Set.mem_insert_iff] using hvars hiVars + rcases hiAllowed with rfl | his + · simp + · exact False.elim ((Finsupp.mem_support_iff.mp hi) (haux i his)) + have hmform : m = Finsupp.single t (m t) := + Finsupp.support_subset_singleton.mp hsupp + have hdegree : m.degree = N := by + rw [Finsupp.degree_eq_weight_one] + exact hP (MvPolynomial.mem_support_iff.mp hmP) + rw [hmform, Finsupp.degree_single] at hdegree + exact hmt (by rw [hmform, hdegree]) + +/-- A prime containing a homogeneous relation, all auxiliary +variables, and a unit pure coefficient must contain the distinguished +variable. -/ +theorem X_mem_of_homogeneous_mem_prime + {P : MvPolynomial σ R} {N : ℕ} {t : σ} {s : Set σ} {c : R} + (hP : P.IsHomogeneous N) + (hvars : (P.vars : Set σ) ⊆ insert t s) + (hcoeff : P.coeff (Finsupp.single t N) = c) + (hc : IsUnit c) + {p : Ideal (MvPolynomial σ R)} (hp : p.IsPrime) + (hPmem : P ∈ p) + (hsmem : ∀ i ∈ s, MvPolynomial.X i ∈ p) : + MvPolynomial.X t ∈ p := by + have hdiff : + P - MvPolynomial.monomial (Finsupp.single t N) c ∈ p := + (Ideal.span_le.mpr (by + rintro _ ⟨i, hi, rfl⟩ + exact hsmem i hi)) + (sub_pureMonomial_mem_span_X hP hvars hcoeff) + have hmono : MvPolynomial.monomial (Finsupp.single t N) c ∈ p := by + have := p.sub_mem hPmem hdiff + simpa only [sub_sub_cancel] using this + rw [← MvPolynomial.C_mul_X_pow_eq_monomial] at hmono + have hC : IsUnit (MvPolynomial.C c : MvPolynomial σ R) := + hc.map (MvPolynomial.C : R →+* MvPolynomial σ R) + have hpow : MvPolynomial.X t ^ N ∈ p := + (p.unit_mul_mem_iff_mem hC).mp hmono + exact hp.mem_of_pow_mem N hpow + + +end AlgebraicAnalysis.MvPolynomial diff --git a/LeanPool/Stafford38/AlgebraicAnalysis/RingTheory/TwoGeneratorIdentity.lean b/LeanPool/Stafford38/AlgebraicAnalysis/RingTheory/TwoGeneratorIdentity.lean new file mode 100644 index 0000000000..c1002a87ec --- /dev/null +++ b/LeanPool/Stafford38/AlgebraicAnalysis/RingTheory/TwoGeneratorIdentity.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.RingTheory.OreLocalization.Ring +public import LeanPool.Stafford38.AlgebraicAnalysis.Ore.RightLocalization + + +/-! +# Two-generator identities and unit-denominator transport + +This neutral module extracts the reusable algebraic kernel formerly declared as +`Stafford38.LocalizationCorollaries.S38`, +`Stafford38.LocalizationCorollaries.s38_of_rightClearing`, and +`Stafford38.LocalizationCorollaries.s38_of_leftUnitClearing`. + +Source record: Stafford38 commit `1585e4c7`, originally +`Stafford38/LocalizationCorollaries.lean` and +`Stafford38/LeftDenominatorTransport.lean`. +The extracted declarations are application-independent; Stafford38-specific +names and imports are intentionally absent. The written multiplication order +is preserved. +-/ + +@[expose] public section + +namespace AlgebraicAnalysis + +universe u v + +/-- The two-generator identity in a ring, with the distinguished factor on +the left of the first product and in the middle of the second. -/ +def TwoGeneratorIdentity (R : Type u) [Ring R] : Prop := + ∀ d : R, d ≠ 0 → ∃ F r s : R, (1 : R) = d * r + F * d * s + +/-- Right-clearing transport of the two-generator identity. -/ +theorem TwoGeneratorIdentity.of_rightUnitClearing + {R : Type u} {L : Type v} [Ring R] [Ring L] + {f : R →+* L} (hR : TwoGeneratorIdentity R) + (hclear : ∀ q : L, q ≠ 0 → + ∃ a s : R, IsUnit (f s) ∧ q * f s = f a) : + TwoGeneratorIdentity L := by + intro q hq + rcases hclear q hq with ⟨a, s, hs, hqa⟩ + have ha : a ≠ 0 := by + intro ha + have hzero : q * f s = 0 := by simpa [ha] using hqa + exact hq (hs.mul_right_cancel (by simpa using hzero)) + rcases hR a ha with ⟨F, r, t, hone⟩ + refine ⟨f F, f s * f r, f s * f t, ?_⟩ + have hm := congrArg f hone + simp only [map_add, map_mul] at hm + calc + (1 : L) = f a * f r + f F * f a * f t := by simpa using hm + _ = q * (f s * f r) + f F * q * (f s * f t) := by + rw [← hqa] + simp [mul_assoc] + +/-- Left-clearing transport of the two-generator identity. -/ +theorem TwoGeneratorIdentity.of_leftUnitClearing + {R : Type u} {L : Type v} [Ring R] [Ring L] + {f : R →+* L} (hR : TwoGeneratorIdentity R) + (hclear : ∀ q : L, q ≠ 0 → + ∃ a : R, ∃ u : L, IsUnit u ∧ u * q = f a) : + TwoGeneratorIdentity L := by + intro q hq + rcases hclear q hq with ⟨a, u, hu, hqa⟩ + have ha : a ≠ 0 := by + intro ha + have hzero : u * q = 0 := by simpa [ha] using hqa + exact hq (hu.mul_left_cancel (by simpa using hzero)) + rcases hR a ha with ⟨F, r, t, hone⟩ + let U : Lˣ := hu.unit + let ui : L := U.inv + have hui : ui * u = 1 := by + dsimp [ui, U] + exact U.inv_mul + have hui' : u * ui = 1 := by + dsimp [ui, U] + exact U.val_inv + refine ⟨ui * f F * u, f r * u, f t * u, ?_⟩ + have hm := congrArg f hone + simp only [map_add, map_mul] at hm + have hm' : (1 : L) = (u * q) * f r + f F * (u * q) * f t := by + simpa [hqa] using hm + have hm'' := congrArg (fun z : L => ui * z * u) hm' + have hm''' : (1 : L) = ui * ((u * q) * f r + f F * (u * q) * f t) * u := by + simpa [hui, mul_assoc] using hm'' + calc + (1 : L) = ui * ((u * q) * f r + f F * (u * q) * f t) * u := hm''' + _ = q * (f r * u) + (ui * f F * u) * q * (f t * u) := by + simp only [mul_add, add_mul, ← mul_assoc, hui, one_mul] + +/-- The two-generator identity is preserved by the right Ore localization +implemented through the opposite ring. -/ +theorem TwoGeneratorIdentity.of_rightOreLocalization + {R : Type u} [Ring R] {S : Submonoid R} + [OreLocalization.OreSet + (AlgebraicAnalysis.OreRightLocalization.oppositeSubmonoid S)] + (hR : TwoGeneratorIdentity R) : + TwoGeneratorIdentity + (AlgebraicAnalysis.OreRightLocalization.RightOreLocalization R S) := by + apply TwoGeneratorIdentity.of_rightUnitClearing + (f := AlgebraicAnalysis.OreRightLocalization.rightNumeratorRingHom (R := R) (S := S)) hR + intro q hq + rcases AlgebraicAnalysis.OreRightLocalization.rightOre_clear (S := S) q with + ⟨a, s, _, hs, hclear⟩ + exact ⟨a, s, hs, hclear⟩ + +end AlgebraicAnalysis diff --git a/LeanPool/Stafford38/FixedSourceSolution.lean b/LeanPool/Stafford38/FixedSourceSolution.lean new file mode 100644 index 0000000000..1d896ffdc7 --- /dev/null +++ b/LeanPool/Stafford38/FixedSourceSolution.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import LeanPool.Stafford38.Stafford38.FoundationClosure +public import LeanPool.Stafford38.Stafford38.FixedSourceChallengeTransport + + +/-! +# Solution for the exact-source challenge + +The substantive development proves the exact fixed-source theorem on the same +`RingQuot` presentation of the Weyl algebra +(`Stafford38.universalFixedSourceStatement`). The transport module identifies +the challenge's intrinsic ordered-word filtration and its least-level degree +with the development's checked PBW normal-form filtration and degree, and the +two linear symplectic coordinate predicates are definitionally equal. This +file only combines those facts; it adds no hypothesis and supplies no degree +or normal-form datum. +-/ + +@[expose] public section + +namespace Stafford38FixedSourceChallenge + +universe u + +theorem universalFixedSourceStatement : UniversalFixedSourceStatement := by + intro k _ _ n d hd + obtain ⟨ell, R, S, hell, hcert⟩ := + Stafford38.universalFixedSourceStatement (k := k) n d hd + have hdeg := Stafford38FixedSourceChallengeTransport.bernsteinDegree_eq k d + refine ⟨ell, R, S, + (Stafford38FixedSourceChallengeTransport.isLinearWeylCoordinate_iff + k n ell).mpr hell, ?_⟩ + rw [hdeg] + exact hcert + +end Stafford38FixedSourceChallenge diff --git a/LeanPool/Stafford38/Proofs/Stafford38Reduction.lean b/LeanPool/Stafford38/Proofs/Stafford38Reduction.lean new file mode 100644 index 0000000000..9f193c185a --- /dev/null +++ b/LeanPool/Stafford38/Proofs/Stafford38Reduction.lean @@ -0,0 +1,118 @@ +/- +Copyright (c) 2026 Christopher Albert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Albert +-/ + +module + +public import Mathlib.Algebra.Algebra.Equiv +public import Mathlib.Tactic + + +/-! +# Transport of Stafford certificates + +The right-ideal certificate is `1 = e * R + F * e * S`. +This module supplies the generic conditional reduction from monicization and +an exponent hypothesis, together with transport through algebra automorphisms +and nonzero scalars. These conditional interfaces are retained for current +imports; the unconditional theorem is proved in `Stafford38.FoundationClosure`. +-/ + +@[expose] public section + +namespace Stafford +namespace Reduction + +variable {k A : Type*} [Field k] [Ring A] [Algebra k A] + +/-- The commutator `ad Y u = Y * u - u * Y`. -/ +def ad (Y u : A) : A := Y * u - u * Y + +/-- Stafford 3.8 for a single element, in written operator order. -/ +def Stafford38 (e : A) : Prop := ∃ F R S : A, (1 : A) = e * R + F * e * S + +/-- The monic right-coefficient presentation `X ^ N + ∑_{i